基于测试类型复制指定列至其他工作表的VBA代码通用化需求

需求说明 #

• 实验共40名参与者，每人对应唯一编号（原工作表I列）
• 每位参与者完成2项测试，测试类型对应原工作表「测试类型」列
• 需将原工作表中对应每项测试的B、C、D列数据，复制到以测试类型命名的目标工作表（如Dr_Pi_1、Ju_Pi_2）
• 目标工作表布局：A、B列为固定内容，后续每3列对应一位参与者的测试数据，且首行需填充该参与者的编号

现有特定场景代码 #

Sub Macro5()
    
    x = 1
    Row_increase = 0
    Column_increase = 0
    For x = 1 To 40
        Sheets("Relevant Data").Select
        Range(Cells(2 + Row_increase, 2), Cells(91 + Row_increase, 4)).Select
        Selection.Copy
        Sheets("Drops_PIC_Data").Select
        Cells(2, 3 + Column_increase).Select
        ActiveSheet.Paste
        Sheets("Relevant Data").Select
        Cells(2 + Row_increase, 9).Select
        Selection.Copy
        Sheets("Drops_PIC_Data").Select
        Range(Cells(1, 3 + Column_increase), Cells(1, 5 + Column_increase)).Select
        ActiveSheet.Paste
        Row_increase = Row_increase + 181
        Column_increase = Column_increase + 3
        
    Next x
End Sub

通用化改进代码 #

Sub 按测试类型整理数据()
    Dim 原表 As Worksheet
    Dim 目标表 As Worksheet
    Dim 参与者编号 As String
    Dim 测试类型 As String
    Dim 原数据起始行 As Long
    Dim 目标列起始位置 As Integer
    Dim 数据行数 As Long ' 每项测试的行数，对应原代码中90行数据（91-2+1）
    Dim 参与者计数 As Integer
    
    ' 初始化基础参数
    Set 原表 = ThisWorkbook.Sheets("Relevant Data")
    数据行数 = 90 ' 可根据实际测试数据行数调整
    参与者计数 = 0
    
    ' 遍历所有参与者的测试数据（假设每行对应一项测试，每人2项测试，步长设为2）
    For 原数据起始行 = 2 To 原表.Cells(原表.Rows.Count, "I").End(xlUp).Row Step 2
        参与者计数 = 参与者计数 + 1
        ' 获取当前参与者的编号和测试类型
        参与者编号 = 原表.Cells(原数据起始行, "I").Value
        测试类型 = 原表.Cells(原数据起始行, "测试类型").Value ' 若列名不同，可替换为列号如"F"
        
        ' 检查目标工作表是否存在，不存在则新建
        On Error Resume Next
        Set 目标表 = ThisWorkbook.Sheets(测试类型)
        On Error GoTo 0
        If 目标表 Is Nothing Then
            Set 目标表 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            目标表.Name = 测试类型
            ' 可在此添加A、B列固定内容初始化代码，示例：
            ' 目标表.Range("A1:B1") = Array("固定标题1", "固定标题2")
            ' 目标表.Range("A2:A" & 数据行数 + 1) = "固定内容"
        End If
        
        ' 计算当前参与者数据在目标表的起始列
        目标列起始位置 = 3 + (参与者计数 - 1) * 3
        
        ' 复制测试数据到目标表
        原表.Range(原表.Cells(原数据起始行, "B"), 原表.Cells(原数据起始行 + 数据行数 - 1, "D")).Copy _
            目标表.Cells(2, 目标列起始位置)
        
        ' 复制参与者编号到目标表首行对应列
        目标表.Range(目标表.Cells(1, 目标列起始位置), 目标表.Cells(1, 目标列起始位置 + 2)).Value = 参与者编号
        
        ' 重置目标表对象，避免循环冲突
        Set 目标表 = Nothing
    Next 原数据起始行
    
    MsgBox "数据整理完成！"
End Sub

通用化核心优化点 #

• 动态识别测试类型：自动根据原表的测试类型创建/选择目标工作表，无需硬编码表名
• 灵活适配数据规模：通过变量调整测试数据行数，自动识别原表最后一行数据，不用固定循环次数
• 高效无冗余操作：去掉原代码的Select/Paste冗余步骤，直接引用单元格复制，运行更稳定快速
• 自动初始化目标表：不存在的测试类型工作表会自动创建，可按需添加A、B列固定内容初始化逻辑

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