1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub TextJoinSub()

'************************
Set RefR = Range("A:A") '原來源的編號欄
ResultCol = 8 '輸出來源的編號欄(數字)
'************************

RefLR = Cells(Rows.Count, RefR.Column).End(xlUp).Row

For Each cellR In Range(Cells(1, RefR.Column), Cells(RefLR, RefR.Column))
    RefNo = cellR
    RepeatNo = Application.CountIf(RefR, RefNo)
    ResultC = ResultC + 1
    Cells(ResultC, ResultCol) = RefNo
    
    If RepeatNo > 1 Then
        For Each CellR2 In Range(Cells(1, RefR.Column), Cells(RefLR, RefR.Column))
            If RefNo = CellR2 Then
                ResultD = ResultD & Cells(CellR2.Row, RefR.Column + 1)
                CountInput = CountInput + 1
                
                If CountInput = RepeatNo Then
                    Exit For
                End If
            End If
            
        Next
    Else
        ResultD = Cells(cellR.Row, RefR.Column + 1)
    End If
    
    Cells(ResultC, ResultCol + 1) = ResultD
    ResultD = vbNullString
    CountInput = 0
    
Next
End Sub