vba - Excel VBA 中引用相邻单元格的最有效方法是什么？

Question

我尝试使用 with 语句，因为它们比循环更快。

共有 72,000 行，具体数字可能有所不同。项目代码需要输入 A 列，具体取决于 B 列中的货币代码。

我正在引用一个集合来根据货币代码检索代码。我能实现这一目标的最快方法是什么？这是我的代码...它不起作用。

Sub Collector()

Dim cn As Collection
Dim LastRow As Long
Dim cur As Long
Dim destws As Worksheet

Set destws = ThisWorkbook.Worksheets("Data")

Set cn = New Collection
cn.Add "120000037650264", "AUD"
cn.Add "140000028802654", "CAD"
cn.Add "106000061411232", "CHF"
cn.Add "100700037144679", "CNY"
cn.Add "108000077165454", "EUR"
cn.Add "100900028865402", "GBP"
cn.Add "100700034152263", "HKD"
cn.Add "103000037165403", "HUF"
cn.Add "100400055172256", "INR"
cn.Add "100090035614270", "JPY"
cn.Add "100600035472288", "KRW"
cn.Add "100040036172267", "MXN"
cn.Add "100004036162300", "PLN"
cn.Add "121000037176585", "RUB"
cn.Add "133000040272294", "THB"
cn.Add "100430020172276", "TWD"
cn.Add "109790029172291", "UAH"
cn.Add "100004007305201", "USD"
cn.Add "100003051687277", "ZAR"

LastRow = destws.Cells(Rows.Count, 2).End(xlUp).Row


    With destws.Range("A2:A" & LastRow)
        .Value = cn.Item(Cells(cur, 2).Value) 'generates object defined error
    End With

End Sub

示例:如果单元格 B2 的值为美元，我希望单元格 A2 的值为 100004007305201。

任何帮助将不胜感激!

Answer 1

通过索引访问Collection项绝对是一个性能问题。集合想要在 For Each 循环中迭代!如果您事先知道需要多少元素，最好使用数组；通过索引访问数组项正是数组最擅长的(这就是为什么它们最好使用 For 循环进行迭代)。

在循环中写入Range也效率非常低。

现在，您不是将集合/数组项转储到 Range 中 - 您正在查找键/值对。最有效的方法是使用字典。 Collection 也可以设置键值(就像您所做的那样)，但我喜欢称猫为猫，所以我使用 Dictionary 作为键值对。

Note: I'm going to assume your key/value pairs are account/currency. Adjust as needed; the idea is to name things, so that the code speaks for itself.

您可以使用一个私有(private)函数CreateAccountsByCurrencyDictionary来创建、填充并返回一个Dictionary，然后您的宏可以有一个Static局部变量(这样每次调用宏时它就不会无用地重新初始化)来保存它:

Static accountsByCurrency As Scripting.Dictionary 'reference Microsoft Scripting Runtime
If accountsByCurrency Is Nothing Then
    Set accountsByCurrency = CreateAccountsByCurrencyDictionary
End If

然后获取工作范围并将其转储到二维数组中 - 最简单的方法是将数据存储在 ListObject 中(即命名表)；您可以通过从“主页”功能区选项卡中选择“格式为表格”轻松将范围转换为表格 - 然后您无需跟踪最后一行的位置，表格会为您完成!

Here Sheet1 is the code name of the worksheet you need to work with. Always qualify Range calls with a specific worksheet object. By using the sheets' code name, you make your code work regardless of what the ActiveSheet is.

Dim target As Range
Set target = Sheet1.ListObjects("TableName").DataBodyRange

Dim values As Variant
values = target.Value

现在您已经有了一个 2D 数组(values)，使用 For 循环对其进行迭代并进行查找:

Dim currentRow As Long
For currentRow = LBound(values, 1) To UBound(values, 1)

    ' never assume you're looking at valid data
    Dim currentKeyValue As Variant
    currentKeyValue = values(currentRow, 1)
    Debug.Assert Not IsError(currentKeyValue) ' there's a problem in the data

    ' key is a valid string, but might not exist in the lookup dictionary
    Dim currentKey As String
    currentKey = currentKeyValue
    If accountsByCurrency.Exists(currentKey) Then
        ' lookup succeeded, update the array:
        values(currentRow, 1) = accountsByCurrency(currentKey)
    Else
        Debug.Print "Key not found: " & currentKey, "Index: " & currentRow
        Debug.Assert False ' dictionary is missing a key. what now?
    End If
Next

如果一切顺利，values 数组现在包含您更正后的值，您可以更新实际的工作表 - 由于您的值位于 2D 数组中，因此这是一条指令!

target.Value = values

CreateAccountsByCurrencyDictionary 函数可能如下所示:

Private Function CreateAccountsByCurrencyDictionary() As Scripting.Dictionary
    Dim result As Scripting.Dictionary
    Set result = New Scripting.Dictionary
    With result
        .Add "AUD", "120000037650264"
        .Add "CAD", "140000028802654"
        '...
    End With
    Set CreateAccountsByCurrencyDictionary = result
End Function

或者，可以从另一个工作表填充这些值，而不是硬编码。重点是，如何获取查找值本身就是一个问题，并且属于它自己的范围/过程/函数。