是否有VBA函数或公式按ID号分组结果？

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

这里有一个小小的VBAfunction（需要微调）

 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