如何使用 VBA 循环遍历多数组？答案

【问题标题】：How do you loop through multi array using VBA?如何使用 VBA 循环遍历多数组？
【发布时间】：2015-04-29 19:21:30
【问题描述】：

我在 Excel (TABLE) 中有下表。

我正在尝试循环遍历数组 (CODE) 中的表格和故事。

然后循环遍历数组并根据 ID (OUTPUT) 生成唯一的输出。

我已经提供了我拥有的代码，但在确定循环遍历 ID 相同的数组的最佳方式时遇到了问题 - 即我想按 ID 对数组输出进行分组。

表格

| ID | Name | Value |
---------------------
| 01 | John | Value |
| 01 | Sam  | Value |
| 02 | Luke | Value |
| 03 | Jack | Value |
| 04 | Rob  | Value |
| 04 | Bob  | Value |

输出

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

代码

'Store Array
For row = 2 to 6
   MyArray(i,0) = Cells(row,1).value
   MyArray(i,1) = Cells(row,2).value
   MyArray(i,2) = Cells(row,3).calue
next row

'Output Array
For a = Lbound(MyArray) to Ubound(MyArray)
    ???
Next a

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

【问题讨论】：

标签： arrays vba excel

【解决方案1】：

假设我们从：

并且我们想要您的帖子中的输出。运行这个：

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

将产生：

【讨论】：

【解决方案2】：

我将发布使用Dictionary 的版本。

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 行的大小方面存在限制。
只要您的数据不接近该值，那么您应该没问题。
但是，如果您有大量数据，则必须使用另一个循环来获取值（例如手动转置数据）。

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

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

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

【讨论】：