excel - 从多维数组打印值

Question

我有一个数据 block ，我在 excel 中定义为一个范围(“ARRAY_DIM”)。该范围包括大量数据，但也有许多行和列根本没有数据。下面是定义范围的示例。请注意，每个标识符的数据列数各不相同，这就是为什么 ARRAY_DIM 定义为 +100 列(其中只有几行包含数据)。

Banana  10  20  30  40  50  70
Parrot  5       1   4   30
Apple   3   3   5   6       20
Car     10  20  30  40  30
Donkey  4   12  3   0   4   5
Coconut     10      4   0   1

我将所有这些数据插入到一个数组中，这样我就可以遍历相关标识符列表，然后将与标识符关联的数据粘贴到相邻单元格(同一行)中。请参阅下面的标识符的简化示例(第一列是定义为“输出”的范围)以及我打算在其中粘贴数组中包含的标识符的相关数据。

Banana  10  20  30  40  50  70
SHARK 
Apple   3   3   5   6       20
Airplane

根据下面的代码，我在完成此任务时遇到了麻烦。它适用于第一行/标识符，但随后在 .Cells 输出行出现错误“下标超出范围”。如果有人可以查看代码并指出任何错误，我将不胜感激。

Sub test()

Dim arr As Variant
Dim cell As Range

With ThisWorkbook.Sheets("Sheet1")
    arr = .Range("ARRAY_DIM")
End With

With ThisWorkbook.Sheets("Sheet2")
    For Each cell In .Range("OUTPUT")
        For x = LBound(arr, 1) To UBound(arr, 1)
            If arr(x, 1) = cell.Value Then
                For n = LBound(arr, 1) To UBound(arr, 1)
                    .Cells(cell.Row, n + 2) = arr(x, n + 1)
                Next n
            End If
        Next x
    Next cell
End With

End Sub

Answer 1

这应该处理它，假设第一列中的唯一标签:

Dim data As Object
Dim r As Range
Dim thisName As String
Dim thisData As Range
Set data = CreateObject("Scripting.Dictionary")


With ThisWorkbook.Sheets("Sheet1")
    ' Store each row in our Dictionary with key=item name, value=row values
    For Each r In .Range("ARRAY_DIM").Rows
        Set data(r.Cells(1).Value) = r.Resize(1, r.Columns.Count - 1).Offset(0, 1)
    Next
End With

With ThisWorkbook.Sheets("Sheet2")
    For Each r In .Range("OUTPUT").Columns(1).Cells
        thisName = r.Cells(1).Value
        ' Check if thisName exists in our Dictionary
        If data.Exists(thisName) Then
            ' Dump the data into the row if it exists
            Set thisData = data(thisName)
            r.Offset(0, 1).Resize(1, thisData.Columns.Count).Value = thisData.Value
        End If
    Next
End With

但我认为可以进一步简化为单个循环:

Dim r As Range
Dim thisName As String
Dim thisData As Range
Dim outputRow As Variant
Dim outputRange as Range
Set outputRange = ThisWorkbook.Sheets("Sheet2").Range("OUTPUT")
With ThisWorkbook.Sheets("Sheet1").Range("ARRAY_DIM")
    For Each r In .Rows
        thisName = r.Cells(1).Value
        ' Check whether thisName exists in outputRange
        outputRow = Application.Match(thisName, outputRange, False)
        If Not IsError(outputRow) Then
            ' Dump this row's Values to the outputRange
            outputRange.Rows(outputRow).Value = r.Value
        End If
    Next
End With

注意:如果 thisName，上述两种方法都不会添加新行。在 OUTPUT 范围内找不到。