怎样把对应相同列名下的内容从 出库汇总表 复制到 目的 表里

王跃峰

怎样把对应相同列名下的内容从 出库汇总表 复制到 目的 表里？, 不想改变 目的 表列名的顺序
如果 目的 表中的列名在 出库汇总表 中没有的, 则显示空白单元格

gwjkkkkk

Sub TEST6()
    Dim arr, vData, i&, j&, R&, dic As Object, strTxt$, vItem
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Sheets(1).[A5].CurrentRegion
    [A2].CurrentRegion.Offset(2).Clear: R = 2
    vData = [A2].CurrentRegion.Resize(UBound(arr) + 1)
    For i = 1 To UBound(vData, 2)
      If vData(1, i) <> "" Then
         dic(vData(1, i) & vData(2, i)) = i: strTxt = vData(1, i)
         Else
         dic(strTxt & vData(2, i)) = i
      End If
    Next i
    For i = 2 To UBound(arr)
       R = R + 1
       For j = 1 To UBound(arr, 2)
          vItem = dic(arr(1, j))
          If vItem <> "" Then
             vData(R, vItem) = arr(i, j)
          End If
       Next j
    Next i
    [A2].Resize(UBound(vData), UBound(vData, 2)) = vData
    With [A2].CurrentRegion
        .Rows("1:2").Font.Bold = True
        .Cells.Font.Size = 9
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请楼主参考 ，有一点建议在文件中进行了说明。。。

王跃峰

gwjkkkkk 发表于 2022-12-2 18:57
请楼主参考 ，有一点建议在文件中进行了说明。。。

太感谢您了

王跃峰

不修改，不知谁会弄！！！

gwjkkkkk

不改的话，加个判断，就行了。。。

王跃峰

gwjkkkkk 发表于 2022-12-2 19:28
不改的话，加个判断，就行了。。。

高，实在是高！