想把竖排打卡数据处理成横排，求助各位大神，非常感谢

小园.

想把竖排打卡数据处理成横排，求助各位大神，非常感谢

3190496160

Sub 考勤整理()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
ar = Sheets("原始源").[a1].CurrentRegion
Dim br()
ReDim br(1 To UBound(ar), 1 To UBound(ar))
k = 1
br(k, 1) = ar(1, 1)
br(k, 2) = ar(1, 2)
y = 2
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        t = d(Trim(ar(i, 1)))
        If t = "" Then
            k = k + 1
            d(Trim(ar(i, 1))) = k
            t = k
            br(k, 1) = ar(i, 1)
            br(k, 2) = ar(i, 2)
        End If
        If Not dc.exists(Trim(ar(i, 10))) Then
            y = y + 1
            br(1, y) = ar(i, 10)
            dc(Trim(br(1, y))) = y
            br(t, y) = Format(ar(i, 11), "h:mm")
        Else
            n = dc(Trim(ar(i, 10)))
            br(t, n) = br(t, n) & Chr(10) & Format(ar(i, 11), "h:mm")
        End If
    End If
Next i
With Sheets("想要得出的结果")
    .[a1].CurrentRegion = Empty
    .[a1].Resize(k, y) = br
End With
MsgBox "ok!"
End Sub

3190496160

想把竖排打卡数据处理成横排.rar (56.75 KB, 下载次数: 11)

2020-11-12 18:45 上传

点击文件名下载附件

小园.

3190496160 发表于 2020-11-12 18:43
Sub 考勤整理()
Dim d As Object
Set d = CreateObject("scripting.dictionary")

好厉害呀，能不能根据数据源自动生成一个工作表，把结果放在那个工作表里，有时数据源的人数和日期会不一样，有几万条数据

3190496160

小园. 发表于 2020-11-13 09:27
好厉害呀，能不能根据数据源自动生成一个工作表，把结果放在那个工作表里，有时数据源的人数和日期会不一 ...

呵呵，说明你根本没有好好的看，目前的代码不需要你在结果工作表中输入任何东西的呀，全部都是代码自动生成的呀

tony@cq

PQ制作如何？

小园.

3190496160 发表于 2020-11-13 09:45
呵呵，说明你根本没有好好的看，目前的代码不需要你在结果工作表中输入任何东西的呀，全部都是代码自动生 ...

我看不懂，我点运行的时候提示找不到工程或库，可以给我讲一下使用方法及该注意的地方吗？非常感谢！！！

小园.

tony@cq 发表于 2020-11-13 11:18
PQ制作如何？

可以告诉我使用方法及该注意的地方吗？非常感谢！！！

3190496160

小园. 发表于 2020-11-13 11:55
我看不懂，我点运行的时候提示找不到工程或库，可以给我讲一下使用方法及该注意的地方吗？非常感谢！！！

我这里肯定是可以运行的，不知用的是什么office

小园.

3190496160 发表于 2020-11-13 12:24
我这里肯定是可以运行的，不知用的是什么office

可以了，会用了，非常非常感谢