Question

我有一块数据，我在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

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

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，上述两种方法均不会添加新行。

从多维数组打印值

1 个答案: