是否有VBA函數或公式按ID號分組結果？

Question

Sheet2中有：

123, thomas 
123, gordon 
123, smith 
334, joey 
334, nancy 
3452, angela 
3452, liza 

結果，我想的是：

123, thomas, gordon, smith 
334, joey, nancy 
3452, angela, liza 

有沒有一種簡單的方法用一個公式來做到這一點？如果不是，我怎樣才能用VBA做到這一點？

Answer 1

這裏有一個小VBA功能（需要微調）

Function GetCSV(r As Range, v As Integer) As String 
    Dim i As Long, j As Long 
    Dim s As String 
    For i = 1 To r.Rows.Count 
     If r.Cells(i, 1) = v Then 
      s = s & ", " & r.Cells(i, 2) 
     End If 
    Next i 
    GetCSV = v & s 
End Function 

使用範例（假設A1：B14是你的數據範圍）

=GetCSV(A1:B14,A1) 

Answer 2

粘貼開始在範圍列的例子（ 「A1」），將代碼粘貼到模塊中並運行。 我要回家了，由你來做格式化，並檢查你是否喜歡它！

Sub Test() 

Dim rRange     As Range 
Dim iRange     As Integer 
Dim rRange_Final   As Range 
Dim sString     As String 
Dim iPosition    As Integer 
Dim sID      As Integer 
Dim sName     As String 

Dim sCheck     As String 
Dim iCnt     As Integer 
Dim iCntB     As Integer 
Dim iCntC     As Integer 
Dim iCntD     As Integer 
Dim vArray()    As Variant 
Dim vArray_Dest()   As Variant 
Dim vArray_Final()   As Variant 
Dim bCheck     As Boolean 

Application.ScreenUpdating = False 

'Set range dynamically and load data into an array 
Set rRange = ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 1).End(xlDown)) 
iRange = rRange.Rows.Count 
ReDim vArray(1 To iRange) 
ReDim vArray_Dest(1 To iRange, 1 To 3) 
vArray = rRange 

'Split based on comma and load into a two dimensional array 
For iCnt = 1 To iRange 
    sString = Trim(vArray(iCnt, 1)) 
    iPosition = InStr(1, sString, ",") + 1 
    sID = Trim(Left(sString, Len(sString) - (Len(sString) - iPosition))) 
    sName = Trim(Mid(sString, iPosition, Len(sString) - iPosition)) 
    vArray_Dest(iCnt, 1) = sID 
    vArray_Dest(iCnt, 2) = sName 
Next iCnt 

iCnt = 0 
iCntC = 0 

'Loop through the newly created array, assign ID 
For iCnt = 1 To iRange 
    sCheck = vArray_Dest(iCnt, 1) 
    If vArray_Dest(iCnt, 3) = Empty Then 
     iCntC = iCntC + 1 
     ReDim Preserve vArray_Final(1 To iCntC) 
     For iCntB = 1 To iRange 
      If sCheck = vArray_Dest(iCntB, 1) Then 
       vArray_Dest(iCntB, 3) = iCntC 
      End If 
     Next iCntB 
    End If 
Next iCnt 

'Loop through the array while building string in separate array 
iCnt = 0 
iCntB = 0 

For iCnt = 1 To iCntC 
    bCheck = False 
    For iCntB = 1 To iRange 
     If vArray_Dest(iCntB, 3) = iCnt And bCheck = False Then 
      vArray_Final(iCnt) = vArray_Dest(iCntB, 1) & ", " & vArray_Dest(iCntB, 2) 
      bCheck = True 
     ElseIf vArray_Dest(iCntB, 3) = iCnt And bCheck = True Then 
      vArray_Final(iCnt) = vArray_Final(iCnt) & ", " & vArray_Dest(iCntB, 2) 
     End If 
    Next iCntB 
Next iCnt 

iCnt = 0 

'Fill in range 
For iCnt = 1 To iCntC 
    ThisWorkbook.Sheets(1).Cells(iCnt, 3).Value = vArray_Final(iCnt) 
Next iCnt 

End Sub