你如何使用VBA循环多个数组？

我有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 | 

OUTPUT

 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语句或另一个循环来实现这一点？

Answer 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 

会产生：

Answer 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是string（例如01 ），而不是格式为"00"数字。 如果是这样的话，那么你需要首先格式化它，然后idkey像下面的idkey一样使用它来获得所需的输出。

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