考勤汇总表提取对应人员的数据

xiangheping

请大佬帮忙把对应人员的考勤从sheet1分别提取到sheet2,sheet3,sheet4对应人员的那栏中等等，可以实现吗

cjc209

Sub 测试()
    Dim dic, itemarr
    Set dic = CreateObject("scripting.dictionary")
    zdh = Sheet1.Range("c" & Rows.Count).End(xlUp).Row
    For i = 5 To zdh Step 3
        关键字 = Sheet1.Cells(i, 2)
        dic(关键字) = Sheet1.Cells(i, 4).Resize(3, 32).Value
    Next
    zdh1 = Sheet2.Range("c" & Rows.Count).End(xlUp).Row
    For i = 5 To zdh1 Step 3
        关键字1 = Sheet2.Cells(i, 2)
        itemarr = dic(关键字1)
        Sheet2.Cells(i, 4).Resize(3, 32) = itemarr
    Next
End Sub

cjc209

再精简就这样
Sub 测试()
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    For i = 5 To Sheet1.Range("c" & Rows.Count).End(xlUp).Row Step 3
        dic(Sheet1.Cells(i, 2)) = Sheet1.Cells(i, 4).Resize(3, 32).Value
    Next
    For i = 5 To Sheet2.Range("c" & Rows.Count).End(xlUp).Row Step 3
        Sheet2.Cells(i, 4).Resize(3, 32) = dic(Sheet2.Cells(i, 2))
    Next
    Set dic = Nothing
End Sub

xiangheping

cjc209 发表于 2023-2-23 09:51
再精简就这样
Sub 测试()
    Dim dic

谢谢，运行说语法错误

ykcbf1100

经测试，可用。

cjc209

xiangheping 发表于 2023-2-23 11:08
谢谢，运行说语法错误

不知道你的表的情况 我在本地运行正确

笨鸟飞不高

12.zip (81.11 KB, 下载次数: 7)

2023-2-23 14:06 上传

点击文件名下载附件

sxbjzjf110

参与一下

xiangheping

ykcbf1100 发表于 2023-2-23 11:14
经测试，可用。

C:\Users\Lenovo\Desktop想再懒一点，如果sheet2、3、4中只有名字没有考勤表格式能实现提取过去吗

ykcbf1100

xiangheping 发表于 2023-2-24 08:52
想再懒一点，如果sheet2、3、4中只有名字没有考勤表格式能实现提取过去吗

可以的，不过，此代码没考虑速度问题。