如何用循环优化VBA多列复制粘贴的重复条件判断代码？

核心优化思路 #

• 用字典存储代码（MP/M/MI/Z/PK/G）与目标工作表的映射关系，避免重复编写大量If-Else判断
• 循环遍历主表所有需要处理的列，自动适配列数增长
• 保留原复制粘贴逻辑的同时，通过批量循环减少冗余代码
• 关闭屏幕更新，提升运行流畅度

完整代码 #

Sub AutoCopyRechts()
    Dim wsSource As Worksheet
    Dim codeSheetMap As Object
    Dim lastCol As Long
    Dim currentCol As Long
    Dim targetWs As Worksheet
    Dim checkRows As Variant
    
    ' 初始化主工作表和映射字典
    Set wsSource = ThisWorkbook.Worksheets("Tabelle1")
    Set codeSheetMap = CreateObject("Scripting.Dictionary")
    
    ' 建立代码与目标工作表的对应关系
    codeSheetMap("MP") = "Tabelle7"
    codeSheetMap("M") = "Tabelle5"
    codeSheetMap("MI") = "Tabelle6"
    codeSheetMap("Z") = "Tabelle8"
    codeSheetMap("PK") = "Tabelle9"
    codeSheetMap("G") = "Tabelle10"
    
    ' 定义需要检查的行（对应原代码的5、6、7行）
    checkRows = Array(5, 6, 7)
    ' 获取主表最后一列，自动适配新增列
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 关闭屏幕更新，加快运行速度
    Application.ScreenUpdating = False
    
    ' 循环处理每一列（从C列开始，可根据需求调整起始列）
    For currentCol = 3 To lastCol
        ' 遍历当前列需要检查的行
        For Each rowNum In checkRows
            Dim currentCode As String
            currentCode = Trim(wsSource.Cells(rowNum, currentCol).Value)
            
            ' 如果代码在映射表中，执行复制粘贴
            If codeSheetMap.Exists(currentCode) Then
                Set targetWs = ThisWorkbook.Worksheets(codeSheetMap(currentCode))
                ' 获取目标表的空白列
                Dim targetCol As Long
                targetCol = targetWs.Cells(1, targetWs.Columns.Count).End(xlToLeft).Column + 1
                
                ' 执行复制粘贴（保留原逻辑）
                wsSource.Range(wsSource.Cells(1, currentCol), wsSource.Cells(354, currentCol)).Copy
                targetWs.Cells(1, targetCol).PasteSpecial
                Application.CutCopyMode = False
            End If
        Next rowNum
    Next currentCol
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "数据复制完成！"
End Sub

关键说明 #

1. 字典映射：后续新增代码或调整目标工作表时，只需在codeSheetMap中添加/修改对应关系，无需改动判断逻辑
2. 自动适配列数：通过lastCol自动获取主表最后一列，新增列无需修改循环范围
3. 灵活调整检查行：如果需要检查其他行，修改checkRows = Array(5,6,7)中的数组值即可
4. 起始列修改：若要从其他列开始处理，将For currentCol = 3 To lastCol中的3（C列对应第3列）改为目标列的序号

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