通过每个循环中的数组名称字典引用数组

Question

为了提高速度，我正在重写这个宏以使用数组而不是范围。

似乎使用 Array(key) 传递每个数组的字典名称可用于初始化 for each 循环，但随后将字典键作为数组引用则不能。我还尝试以与 for each 循环相同的方式将字典键重新初始化为数组。

有没有更好或更有效的方法来做到这一点？

Sub test2()

Dim arr, arr_1, arr_2, arr_3, arr_4, arr_5, arr_6, arr_7, totalrng As Variant
Dim rowcount, x, rowx As Long

With Sheets("sheet1")
    rowcount = .Cells(Rows.Count, 1).End(xlUp).Row

Set arr_1 = .Range("D1:D" & rowcount)
Set arr_2 = .Range("F1:F" & rowcount)
Set arr_3 = .Range("H1:H" & rowcount)
Set arr_4 = .Range("J1:J" & rowcount)
Set arr_5 = .Range("L1:L" & rowcount)
Set arr_6 = .Range("N1:N" & rowcount)
Set arr_7 = .Range("P1:P" & rowcount)

Dim dict As Variant
    Set dict = CreateObject("scripting.dictionary")
    dict.Add Key:="arr_1", Item:=Nothing
    dict.Add Key:="arr_2", Item:=Nothing
    dict.Add Key:="arr_3", Item:=Nothing
    dict.Add Key:="arr_4", Item:=Nothing
    dict.Add Key:="arr_5", Item:=Nothing
    dict.Add Key:="arr_6", Item:=Nothing
    dict.Add Key:="arr_7", Item:=Nothing

For Each Key In dict
Debug.Print findrng
    x = 2
    For Each num In Array(Key)
        arr = Array(Key)
        .Cells(x, 22).Value = arr(1, 1)
        .Cells(x, 23).Value = arr(1, 2)
        x = x + 1
    Next num
Next Key

End With

End Sub

Answer 1

在为您提供替代解决方案之前，这里有一些关于您现有代码的注意事项。

变量声明

使用以下声明...

Dim rowcount, x, rowx As Long

...rowcount 和 x 都被声明为 Variant，而不是 Long，并且 rowx 被声明为 Long。要将所有变量声明为 Long，请按如下方式声明它们...

Dim rowcount as Long, x as Long, rowx as Long

对于 dict/Next 中的每个键

每次迭代时，都会为 Key 分配一个文本值（即“arr_1”），而不是数组。因此，Array(Key) 返回一个 Variant，其中包含一个从零开始的单元素数组。因此，例如，在第一次迭代中，第一个元素将是文本“arr_1”。

For Each num In Array(Key)/Next

每次迭代时，num 都会从 Array(Key) 中分配一个元素。但是，由于 Array(Key) 由单个元素组成，因此只有一次迭代，其中 num 将简单地分配文本“arr_1”。

arr = 数组（键）

arr 被分配了一个单元素数组，因为 Array(Key) 返回一个单元素数组。因此，将使用 arr(0) 检索单个项目。

替代解决方案

Option Explicit

Sub test()

    Dim sourceRange As Range
    Dim lastRow As Long
    With Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set sourceRange = .Range("D1:P" & lastRow)
    End With

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim colIndex As Long
    With sourceRange
        For colIndex = 1 To .Columns.Count Step 2
            'key is being assigned the column number
            'item is being assigned a two-dimensional (n by 1 column) array
            dict.Add Key:=.Columns(colIndex).Column, item:=.Columns(colIndex).Value
        Next colIndex
    End With

    Dim dictionaryItem As Variant
    Dim currentArray As Variant
    Dim i As Long
    For Each dictionaryItem In dict.items()
        currentArray = dictionaryItem
        For i = LBound(currentArray) To UBound(currentArray)
            Debug.Print currentArray(i, 1)
        Next i
    Next dictionaryItem

End Sub