excel - 結果をID番号でグループ化するVBA関数または式はありますか?

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