excel 宏命令 VB 选择字段名相同的多行数据，复制到另一sheet

Sub 选择字段名相同的数据复制()
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Sheets("灯具模板")
        arr = .[a1].CurrentRegion
        l = UBound(arr, 2)
        For i = 1 To l
            d(arr(1, i)) = i
        Next
        
        arr = Sheets("sheet1").[a1].CurrentRegion
        h = UBound(arr) - 1
        ReDim brr(1 To h, 1 To l)
        
        For i = 2 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                If d.exists(arr(1, j)) Then brr(i - 1, d(arr(1, j))) = arr(i, j)
            Next
        Next
        
        .[a1].CurrentRegion.Offset(1).Clear
        .[a2].Resize(h, l) = brr
    End With
   
End Sub

excel宏处理

原数据

执行前 执行后