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

时间：2018-02-02 16:43:24

标签： excel vba excel-vba

我试图使用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。

非常感谢任何帮助！

4 个答案:

答案 0 :(得分：5)

按索引访问Collection项肯定是一个性能问题。集合想要在For Each循环中迭代！如果您事先知道需要多少物品，最好使用阵列;通过索引访问数组项正是数组最擅长的（这就是为什么它们最好用For循环迭代）。

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

现在，您没有将集合/数组项目转储到Range - 您正在查找键/值对。执行此操作的最有效方法是使用Dictionary。 Collection也可以键入（就像你一样），但我喜欢把猫叫做猫，所以我使用Dictionary作为键值对。

  

注意：我将假设您的键/值对是帐户/货币。根据需要调整;我们的想法是为事物命名，以便代码能说明问题。

您可以使用Private Function CreateAccountsByCurrencyDictionary创建，填充并返回Dictionary，然后您的宏可以拥有Static局部变量（这样每次都不会无用地重新初始化调用宏来保存它：

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

然后你抓住你的工作范围并将其转储到2D数组中 - 最简单的方法是让你的数据存在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

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

答案 1 :(得分：1)

我最初的想法是，如果你只看一个单元格（A2），你没有定义cur可以定义如下：

With destws.Range("A2")
    cur = .Column + 1
    .Value = cn.Item(Cells(cur, 2).Value)
End With

但是既然你正在研究很多单元格，那么最好一次使用一个数组写入单元格，这样可以大大提高速度。

Sub Collector()

Dim cn As Collection
Dim LastRow 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

Dim MyArray() As Variant
MyArray() = destws.Range("B2:B" & LastRow)

Dim i As Long
For i = 1 To UBound(MyArray,1)
    MyArray(i, 1) = cn.Item(MyArray(i, 1))
Next i

destws.Range("A2:A" & LastRow).Value2 = MyArray


End Sub

答案 2 :(得分：0)

这个怎么样; 

Sub Collector()

Dim cn As Collection
Dim LastRow As Long
Dim cur As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required.
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 = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row

Application.Calculation = xlManual
    For i = 2 To LastRow
        ws.Cells(i, 1).Value = cn.Item(ws.Cells(i, 2).Value)
    Next i
Application.Calculation = xlCalculationAutomatic
End Sub

答案 3 :(得分：0)

从快速查看，你使用类似于循环中的cur，它将遍历你的数组并进行更改，例如：

Dim cur as Long, lr as Long
lr = cells(rows.count, 1).end(xlup).row 'dynamic last row
For cur = 2 to lr step 1
    Select Case Cells(cur,3).Value
    Case "AUD"
        Cells(cur,2).value = "120000037650264"
    Case "" 'add in others
        Cells...blah blah blah        
    End Select
Next i

如果您有一个包含这些值的表，那么只需使用带有vlookup或索引/匹配的公式，这将是最有意义的，例如：

'Where your table is on Sheet2 with Column A being the currency code (3-letter code) code and Column B being the item code
'Where you are working on Sheet1
=INDEX(Sheet2!B:B,MATCH(Sheet1!C1,Sheet2!A:A,0)) 'in column B for the active row
相关问题
最新问题