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值为USD,我希望单元格A2的值为100004007305201.

任何帮助将不胜感激!

Answer 1

Collection按索引访问项目绝对是一个性能问题.集合想要For Each循环迭代!如果您事先知道需要多少物品,最好使用阵列; 通过索引访问数组项正是数组最好的(这就是为什么它们最好用For循环迭代).

写入Range循环也非常低效.

现在,您没有将集合/数组项转储到Range- 您正在查找键/值对.最有效的方法是使用a Dictionary.A Collection也可以键入(如你所做的那样),但我喜欢把猫称为猫,所以我使用了一个Dictionary键值对.

注意:我将假设您的键/值对是帐户/货币.根据需要调整; 我们的想法就是命名,以便代码能够说明问题.

你可以有一个Private Function CreateAccountsByCurrencyDictionary创建,填充和返回a Dictionary,然后你的宏可以有一个Static局部变量(这样每次调用宏时都不会无用地重新初始化)来保存它:

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

然后你抓住你的工作范围并将其转储到一个二维数组 - 最简单的方法是让你的数据存在于一个ListObject(即一个命名表)中; 您可以通过从主页功能区选项卡中选择"格式为表格"轻松地将您的范围转换为表格 - 然后您无需追踪最后一行的位置,该表格为您完成!

以下Sheet1是您需要使用的工作表的代码名称.始终Range使用特定工作表对象限定调用.通过使用工作表的代码名称,您可以使代码工作,无论它是什么ActiveSheet.

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

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