Excel VBA 使用数组复制数据到新工作表指定列的实现问题

你可以通过定义源列-目标列映射数组的方式实现自定义对应规则，不用再按数组下标顺序依次对应A列开始的列，改动逻辑如下：

核心改动思路 #

• 放弃原来的单个数组存储源单元格地址的写法，提前定义两组映射规则数组：一组存Dataset表需要取数的列，一组存Forside表对应要写入的目标列，两组数组下标一一对应
• 循环时按映射数组的下标遍历，直接读取对应源列的值写入指定目标列，不用再按x+1默认对应列

修改后的完整代码 #

Sub filtercopyrange()
    Dim x As Long
    Dim iCount As Integer
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim valuee1 As Integer
    Dim lRow2 As Long
    Dim i As Integer
    Dim ct As Variant
    ' 定义映射数组：srcCols存Dataset的源列号，tarCols存Forside的目标列号，下标一一对应
    Dim srcCols As Variant, tarCols As Variant
    
    Set sh1 = Sheets("Dataset")
    Set sh2 = Sheets("Forside")
    
    Application.ScreenUpdating = False
    sh2.Activate
    sh2.Range("A7:Y5000").Clear
    
    valuee1 = sh2.Range("E2").Value
    If Not IsNumeric(valuee1) Then
        GoTo finish ' 直接跳转到收尾逻辑，避免多层嵌套
    End If
    
    ' ************************* 这里修改映射规则即可 *************************
    ' 示例规则：Dataset的A列→Forside的A列，Dataset的D列→Forside的B列，其他列按需求自定义
    srcCols = Array("A", "D", "E", "F", "G", "H", "I", "J", "R", "S")
    tarCols = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
    ' **********************************************************************
    
    lRow2 = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
    iCount = 6
    
    For i = 2 To lRow2
        ct = sh1.Range("L" & i).Value
        If ct = valuee1 Then
            iCount = iCount + 1
            ' 按映射规则赋值
            For x = LBound(srcCols) To UBound(srcCols)
                sh2.Cells(iCount, tarCols(x)).Value = sh1.Range(srcCols(x) & i).Value
            Next x
        End If
    Next i
    
finish:
    sh2.Activate
    Application.ScreenUpdating = True
End Sub

自定义映射的方法 #

你只需要修改srcCols和tarCols两个数组的内容即可，只要保证两个数组的元素顺序一一对应：

• 比如你要让Dataset的D列对应Forside的B列，就把srcCols里的"D"对应位置的tarCols值设为"B"就行
• 目标列不需要按顺序排列，哪怕你要写tarCols = Array("C", "B", "A", "E")这种乱序规则也能正常执行
• 可以随时增删映射对，只要两个数组的元素数量一致即可

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