如何在VBA中更高效地跨工作表引用单元格？

你的现有代码存在冗余变量（大量定义却未使用的货币字符串）、维护成本高（新增货币需修改冗长的ElseIf链）、**效率较低（遍历大量单元格+多条件判断）**等问题，以下是几种更优的实现方式：

方案1：使用Dictionary映射货币与汇率值 #

Scripting.Dictionary是VBA中高效的键值对映射工具，只需提前定义好货币代码与对应汇率的关系，遍历单元格时直接通过键取值，代码简洁易维护。

Sub Cotações_Optimizada()
    Dim rateDict As Object
    Set rateDict = CreateObject("Scripting.Dictionary")
    Dim wsCotacoes As Worksheet
    Set wsCotacoes = ThisWorkbook.Worksheets("Cotações")
    
    ' 加载货币与对应汇率值（提前读取减少工作表IO操作）
    With rateDict
        .Add "AUD", wsCotacoes.Range("N29").Value
        .Add "BWP", wsCotacoes.Range("N33").Value
        .Add "CLF", wsCotacoes.Range("N44").Value
        .Add "COU", wsCotacoes.Range("N45").Value
        .Add "EURO", wsCotacoes.Range("N52").Value
        .Add "FJD", wsCotacoes.Range("N53").Value
        .Add "FKP", wsCotacoes.Range("N83").Value
        .Add "GBP", wsCotacoes.Range("N85").Value
        .Add "GIP", wsCotacoes.Range("N86").Value
        .Add "NZD", wsCotacoes.Range("N88").Value
        .Add "PGK", wsCotacoes.Range("N103").Value
        .Add "SBD", wsCotacoes.Range("N108").Value
        .Add "SHP", wsCotacoes.Range("N114").Value
        .Add "TOP", wsCotacoes.Range("N119").Value
        .Add "WST", wsCotacoes.Range("N146").Value
        .Add "XDR", wsCotacoes.Range("N156").Value
    End With
    
    Dim cell As Range
    Dim lastRow As Long
    ' 仅遍历F列有数据的单元格，避免空单元格遍历
    lastRow = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Rows.Count, "F").End(xlUp).Row
    
    For Each cell In ThisWorkbook.ActiveSheet.Range("F2:F" & lastRow)
        If rateDict.Exists(cell.Value) Then
            cell.Offset(0, 2).Value = cell.Offset(0, 1).Value * rateDict(cell.Value)
        End If
    Next cell
End Sub

方案优势： #

• 减少重复访问工作表的IO操作（VBA中工作表读写是较慢的环节）
• 新增/修改货币只需调整Dictionary的Add项，无需改动核心逻辑
• 仅处理有数据的单元格，提升执行效率

方案2：利用工作表函数批量写入公式（效率最高） #

如果你的汇率表结构固定（比如货币代码在某一列，对应汇率在N列），直接用Excel原生函数批量写入公式，运算效率远高于VBA循环，适合大数据量场景。

假设"Сotações"工作表中，货币代码存放在M列（M29对应AUD、M33对应BWP等），可以用以下代码批量生成计算：

Sub Cotações_Com_Formula()
    Dim lastRow As Long
    lastRow = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Rows.Count, "F").End(xlUp).Row
    
    ' 批量写入公式到H列（F列偏移2列）
    ThisWorkbook.ActiveSheet.Range("H2:H" & lastRow).Formula = _
        "=IFERROR(G2*VLOOKUP(F2,Cotações!M:N,2,FALSE),"""")"
    
    ' 可选：将公式转为静态值，避免后续汇率变动自动更新
    ' ThisWorkbook.ActiveSheet.Range("H2:H" & lastRow).Value = ThisWorkbook.ActiveSheet.Range("H2:H" & lastRow).Value
End Sub

方案优势： #

• 无循环操作，执行速度极快
• IFERROR处理找不到对应货币的情况，避免单元格显示错误值
• 后续调整汇率表结构只需修改公式参数，维护成本极低

方案3：使用Find方法动态查找汇率 #

如果汇率表中货币代码的位置可能变动，不想硬编码单元格地址，可以用Find方法动态定位货币代码所在行，再获取对应N列的汇率值：

Sub Cotações_Com_Find()
    Dim wsCotacoes As Worksheet
    Set wsCotacoes = ThisWorkbook.Worksheets("Cotações")
    Dim findRange As Range
    Dim cell As Range
    Dim lastRow As Long
    
    lastRow = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Rows.Count, "F").End(xlUp).Row
    
    For Each cell In ThisWorkbook.ActiveSheet.Range("F2:F" & lastRow)
        Set findRange = wsCotacoes.UsedRange.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not findRange Is Nothing Then
            cell.Offset(0, 2).Value = cell.Offset(0, 1).Value * wsCotacoes.Cells(findRange.Row, "N").Value
        End If
    Next cell
End Sub

方案优势： #

• 无需硬编码每个货币的单元格地址，适配汇率表结构变动
• LookAt:=xlWhole确保精确匹配货币代码

内容的提问来源于stack exchange，提问作者Rike