Excel VBA条件判断咨询：机器号匹配后复制数据至实操结果表

我来帮你搞定这个需求，下面是结合If…Else条件判断的完整VBA实现方案，附带详细说明：

完整VBA代码实现 #

Sub CopyMatchingMaxScore()
    Dim wsChapter As Worksheet, wsPractical As Worksheet
    Dim lastRowChapter As Long, lastRowPractical As Long
    Dim i As Long, j As Long
    Dim machineIDChapter As String, machineIDPractical As String
    
    ' 绑定对应工作表
    Set wsChapter = ThisWorkbook.Sheets("Sheet1") ' 章节表
    Set wsPractical = ThisWorkbook.Sheets("Sheet3") ' 实操结果表
    
    ' 获取两张表的最后数据行（避免遍历空行浪费资源）
    lastRowChapter = wsChapter.Cells(wsChapter.Rows.Count, "A").End(xlUp).Row ' 假设机器号在A列，按需调整
    lastRowPractical = wsPractical.Cells(wsPractical.Rows.Count, "A").End(xlUp).Row ' 实操表机器号列，按需调整
    
    ' 遍历实操结果表的每一行数据（从第2行开始，默认第1行是表头）
    For i = 2 To lastRowPractical
        machineIDPractical = wsPractical.Cells(i, "A").Value ' 提取当前行的机器号
        
        ' 在章节表中查找匹配的机器号
        For j = 2 To lastRowChapter
            machineIDChapter = wsChapter.Cells(j, "A").Value ' 提取章节表当前行的机器号
            
            ' If条件判断：机器号匹配时执行复制操作
            If machineIDPractical = machineIDChapter Then
                ' 假设章节表最高分在B列，实操表目标栏位在C列，按需修改列标识
                wsPractical.Cells(i, "C").Value = wsChapter.Cells(j, "B").Value
                Exit For ' 找到匹配项后立即退出内层循环，提升效率
            Else
                ' 无匹配时的处理逻辑，可按需修改（比如留空或提示"无匹配"）
                wsPractical.Cells(i, "C").Value = ""
            End If
        Next j
    Next i
    
    MsgBox "数据匹配复制完成！", vbInformation
End Sub

关键逻辑说明 #

1. 工作表与行号初始化：先绑定目标工作表，再获取两张表的最后数据行，避免无效遍历空行。
2. 双层循环遍历：外层循环遍历实操结果表的每一条机器号记录，内层循环在章节表中逐一匹配。
3. If…Else核心判断：
   • 当机器号完全匹配时，将章节表对应的最高分数据复制到实操结果表的指定栏位。
   • 若未找到匹配项，可设置目标栏位为空（或自定义提示文本）。
4. Exit For优化：找到匹配项后立即退出内层循环，减少不必要的遍历操作。

注意事项 #

• 请根据你的实际表格结构调整代码中的列标识（比如机器号所在列、最高分所在列、目标粘贴列）。
• 如果你的表头不在第1行，需要修改循环的起始行号。
• 运行代码前建议先备份工作簿，避免数据意外覆盖。

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