excel - 是否有 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