Arrays 如何使用VBA在多数组中循环？

我在Excel（表格）中有下表

我试图在数组（代码）中循环遍历表和故事

然后循环遍历数组，并根据ID（output）生成唯一的输出

我已经提供了我拥有的代码，但是我很难确定在ID相同的数组中循环的最佳方式-即我想按ID对数组输出进行分组

桌子

输出

01 - John, Sam
02 - Luke
03 - Jack
04 - Rob, Bob

代码

我不知道是使用if/then/else语句还是另一个循环来实现这一点？

假设我们从以下内容开始：

我们想要一个输出，就像你的帖子一样。运行此：

Sub Macro1()

    Range("A2:A22").Copy Range("E1")
    ActiveSheet.Range("$E$1:$E$21").RemoveDuplicates Columns:=1, Header:=xlNo

    For Each r In Range("E1:E22")
        v = r.Value
        If v = "" Then Exit Sub
        For Each rr In Range("A2:A22")
            vv = rr.Value
            If v = vv Then
                If r.Offset(0, 1).Value = "" Then
                    r.Offset(0, 1).Value = rr.Offset(0, 1).Value
                Else
                    r.Offset(0, 1).Value = r.Offset(0, 1).Value & "," & rr.Offset(0, 1).Value
                End If
            End If
        Next rr
    Next r
End Sub

将产生：

---

我将发布使用

字典的版本

Sub Test()
    Dim sh As Worksheet: Set sh = Sheets("Sheet1") ' I try to always be explicit

    With sh
        Dim lr As Long, RawArr
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        RawArr = .Range("A2:C" & lr) ' pass to array
    End With

    Dim i As Long, idkey As String, itm As String
    ' Use Dictionary to handle duplicates and concatenate values
    With CreateObject("Scripting.Dictionary")
        For i = LBound(RawArr, 1) To UBound(RawArr, 1)
            idkey = RawArr(i, 1): itm = RawArr(i, 2)
            If Not .Exists(idkey) Then
                .Add idkey, idkey & " - " & itm
            Else
                .Item(idkey) = .Item(idkey) & ", " & itm
            End If
        Next
        ' Return values to worksheet
        ' Use below if you're working on small data set
        ' If not, replace below with a loop - also posted
        sh.Range("E1:E" & .Count) = Application.Transpose(.Items)
    End With
End Sub

以上内容非常简单，输出与您描述的完全相同。

在最后一部分，我们使用
Application.Transpose
将值传输回工作表。

请注意，它在处理65k行这样的行时有限制。

只要您的数据不接近该值，您就可以了。

但是，如果您有大量数据，则必须使用另一个循环来获取值（例如手动转置数据）

注意：我假设您的ID是字符串（例如
01
），而不是格式化为
“00”
的数字。如果是这种情况，那么您需要先将其格式化，然后再将其用作
idkey
，如下图所示，以获得所需的输出

idkey = Format(RawArr(i, 1), "00")

Sub Test()
    Dim sh As Worksheet: Set sh = Sheets("Sheet1") ' I try to always be explicit

    With sh
        Dim lr As Long, RawArr
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        RawArr = .Range("A2:C" & lr) ' pass to array
    End With

    Dim i As Long, idkey As String, itm As String
    ' Use Dictionary to handle duplicates and concatenate values
    With CreateObject("Scripting.Dictionary")
        For i = LBound(RawArr, 1) To UBound(RawArr, 1)
            idkey = RawArr(i, 1): itm = RawArr(i, 2)
            If Not .Exists(idkey) Then
                .Add idkey, idkey & " - " & itm
            Else
                .Item(idkey) = .Item(idkey) & ", " & itm
            End If
        Next
        ' Return values to worksheet
        ' Use below if you're working on small data set
        ' If not, replace below with a loop - also posted
        sh.Range("E1:E" & .Count) = Application.Transpose(.Items)
    End With
End Sub

Dim key, fArr, n As Long: n = 1
ReDim fArr(1 To .Count, 1 To 2) ' use a 2D array
For Each key In .Keys
    fArr(n, 1) = .Item(key)
    n = n + 1
Next
sh.Range("E1:E" & .Count) = fArr

idkey = Format(RawArr(i, 1), "00")