基于EmpId条件的Excel工作簿间薪资迁移VBA代码问题排查

让我一步步帮你排查这段VBA代码里的问题，顺便帮你修正到符合需求的状态：

1. 核心逻辑错误：赋值对象完全搞反 #

你的需求是把工作簿1（数据源）的薪资复制到**工作簿2（目标）**对应EmpId的单元格，但代码里的赋值语句是：

varSheetB.Cells(j, 2).Value = varSheetB.Cells(i, 2).Value

这相当于把目标工作簿自己的单元格值复制给自己，完全没用到源工作簿（varSheetA）的薪资数据！而且循环嵌套的逻辑也颠倒了——你应该遍历目标工作簿的EmpId，再去源工作簿里匹配，而不是反过来。

正确的赋值逻辑应该是从源工作簿取值，赋值给目标工作簿：

varSheetB.Cells(i, 2).Value = varSheetA.Cells(j, 2).Value

2. 未声明变量与缺失Option Explicit #

代码里的wbkA没有提前声明，而且没有开启Option Explicit——这会让VBA自动把未声明的变量当作变体类型，很容易引发难以排查的隐性错误。建议在代码最顶部强制开启变量声明：

Option Explicit

同时补全所有变量的声明：

Dim wbkA As Workbook

3. 固定循环范围（1到10）的局限性 #

代码里硬编码了循环到第10行，但实际业务数据的行数可能远多于10行，或者不足10行（会无效处理空单元格）。应该用动态方式获取数据的最后一行行号：

' 获取源工作簿的最后数据行
Dim lastRowA As Long
lastRowA = varSheetA.Cells(varSheetA.Rows.Count, 1).End(xlUp).Row

' 获取目标工作簿的最后数据行
Dim lastRowB As Long
lastRowB = varSheetB.Cells(varSheetB.Rows.Count, 1).End(xlUp).Row

之后用lastRowA和lastRowB代替固定的10，适配任意数据量。

4. 工作簿引用不明确 #

Set varSheetA = Worksheets("Sheet1")没有指定所属工作簿，如果当前激活的不是工作簿1，会错误引用其他工作簿的Sheet1。应该明确指定为当前运行代码的工作簿（假设工作簿1是代码所在文件）：

Set varSheetA = ThisWorkbook.Worksheets("Sheet1")

5. 效率问题：双重循环的性能瓶颈 #

如果数据量较大，双重嵌套循环的执行效率会很低。推荐使用**字典（Dictionary）**存储源工作簿的EmpId和对应薪资，然后直接在目标工作簿里匹配查找，速度会提升数倍。

修正后的完整代码 #

下面是结合上述所有修正，且优化了效率的最终代码：

Option Explicit

Sub TransferSalary()
    Dim varSheetA As Worksheet ' 工作簿1（数据源）的Sheet1
    Dim varSheetB As Worksheet ' 工作簿2（目标）的Sheet1
    Dim wbkA As Workbook
    Dim lastRowA As Long, lastRowB As Long
    Dim empIdDict As Object
    Dim i As Long
    
    ' 初始化字典，用于存储源数据的EmpId与对应薪资
    Set empIdDict = CreateObject("Scripting.Dictionary")
    
    ' 明确引用源工作簿的Sheet1
    Set varSheetA = ThisWorkbook.Worksheets("Sheet1")
    lastRowA = varSheetA.Cells(varSheetA.Rows.Count, 1).End(xlUp).Row
    
    ' 将源数据存入字典：Key=EmpId，Item=薪资
    For i = 1 To lastRowA
        If Not empIdDict.Exists(varSheetA.Cells(i, 1).Value) Then
            empIdDict(varSheetA.Cells(i, 1).Value) = varSheetA.Cells(i, 2).Value
        End If
    Next i
    
    ' 打开目标工作簿，请替换成你的实际文件路径
    Set wbkA = Workbooks.Open(Filename:="C:\Your\Target\Workbook\Path.xlsx")
    Set varSheetB = wbkA.Worksheets("Sheet1")
    lastRowB = varSheetB.Cells(varSheetB.Rows.Count, 1).End(xlUp).Row
    
    ' 遍历目标工作簿的EmpId，匹配字典中的薪资并赋值
    For i = 1 To lastRowB
        Dim targetEmpId As Variant
        targetEmpId = varSheetB.Cells(i, 1).Value
        
        If empIdDict.Exists(targetEmpId) Then
            varSheetB.Cells(i, 2).Value = empIdDict(targetEmpId)
        End If
    Next i
    
    ' 保存并关闭目标工作簿
    wbkA.Save
    wbkA.Close SaveChanges:=False
    
    ' 释放对象，避免内存泄漏
    Set varSheetA = Nothing
    Set varSheetB = Nothing
    Set wbkA = Nothing
    Set empIdDict = Nothing
    
    MsgBox "薪资迁移完成！", vbInformation
End Sub

代码说明 #

• 用字典存储源数据，彻底避免了低效的双重循环
• 明确了工作簿/工作表的引用关系，杜绝混淆
• 动态获取数据行，适配任意规模的业务数据
• 加入了对象释放和工作簿关闭逻辑，代码更规范

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