如何把一个表的数据，依据另一张表头项目导到相应单元格

wslpsjh

把人员表的数据，依据表头项目导到相应单元格，人员表有多少人，考勤表就增加多少行

ykcbf1100

楼主是想按队组来复制表吗？

wslpsjh

请看结果图片

wslpsjh

ykcbf1100 发表于 2024-1-31 14:54
楼主是想按队组来复制表吗？

请看结果图片

ykcbf1100

附件供参考。。。

lhj5286

已写好，供楼主参考

gwjkkkkk

Option Explicit
Sub TEST7()
    Dim ar, br, i&, j&, r&, dic As Object, t#, iPosCol&
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    t = Timer
   
    Range("A8:G" & Rows.Count).ClearContents
    With [A6:G6]
        ar = .Resize(10 ^ 3)
        r = 2
        For j = 1 To UBound(ar, 2)
            dic(ar(1, j)) = j
        Next j
    End With
    br = Worksheets(2).[A1].CurrentRegion.Value
    For i = 2 To UBound(br)
        r = r + 1
        For j = 1 To UBound(br, 2)
            If dic.exists(br(1, j)) Then
                iPosCol = dic(br(1, j))
                ar(r, iPosCol) = br(i, j)
            End If
        Next j
    Next i
   
    [A6].Resize(r, UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub

gwjkkkkk

参与一下。。。

wslpsjh

ykcbf1100 发表于 2024-1-31 15:22
附件供参考。。。

老师，您好！如果有50人，能否先复制50行，再填充

wslpsjh

gwjkkkkk 发表于 2024-1-31 19:33
参与一下。。。

老师，您好！能否根据实际人数，有多少人复制多少行，再填充