vba处理数据太耗时：求助大神优化一下代码

fenc

zpy2 发表于 2024-6-6 21:22
https://club.excelhome.net/forum.php?mod=viewthread&tid=1642435&fromguid=hot&extra=&mobile&_dsign= ...

他这个其实已经把多余的打卡记录剔除了，然后转变了一下显示形式。我这个是因为每天的打卡记录太多了，需要将不必要的打卡记录删除掉。目前就是循环记录下标数组和输出文件这一块比较慢，想不到太好的解决办法，所以发上来看看大家有没有更好的方案。

zpy2

fenc 发表于 2024-6-7 09:50
最早打卡时间和最晚打卡时间之间的记录的行下标，这些数据是没用的。

用你的5万行测试一下
手机用sql不到一秒，应该还是页面渲染的时间。
电脑应该会很快。
select f04,substr(f06,2,11),f07,min(f06),rowid old_rowid from consolidateSheet group by f04,substr(f06,2,11),f07 union all
select f04,substr(f06,2,11),f07,max(f06),rowid  from consolidateSheet group by f04,substr(f06,2,11),f07 order by f04,2;

fenc

zpy2 发表于 2024-6-7 10:48
用你的5万行测试一下
手机用sql不到一秒，应该还是页面渲染的时间。
电脑应该会很快。

如果用sql的话，我应该怎么替换原来的代码？

zpy2

fenc 发表于 2024-6-7 11:14
如果用sql的话，我应该怎么替换原来的代码？

我是用在线sql,https://club.excelhome.net/home.php?mod=space&uid=226915&do=blog&id=2023&mobile=2&_dsign=bc8e55d6

你vba可以试试ado方式，应该可以的。

sunya_0529

fenc 发表于 2024-6-7 11:14
如果用sql的话，我应该怎么替换原来的代码？

用VBA里的SQL和WPS里的JSA分别写了宏脚本——

ynzsvt

字典加上考勤机编号干啥？

fenc

sunya_0529 发表于 2024-6-7 16:50
用VBA里的SQL和WPS里的JSA分别写了宏脚本——

谢谢版主解惑，我测试了一下确实用sql语句快了很多。还有一个小问题就是如果这个人只有一条打卡记录的话，它会找出来最小时间和最大时间两条数据，用distinct关键字解决了。

413254881

Sub tttt()
    Dim arr As Variant
    Dim dic As Object: Set dic = CreateObject("scripting.dictionary")
    arr = ThisWorkbook.Sheets("4月份考勤记录").Range("A2:E2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 5).Value
    arr = ArraySortTwo(arr, 3, , 4)
    ReDim Preserve arr(1 To UBound(arr, 1), 1 To UBound(arr, 2) + 1)
    For i = LBound(arr, 1) To UBound(arr, 1)
        AttendanceDate = Split(arr(i, 4), " ")(0)
        AttendanceTime = Split(arr(i, 4), " ")(1)
        arr(i, 4) = AttendanceDate
        arr(i, 6) = AttendanceTime
    Next
    For i = LBound(arr, 1) To UBound(arr, 1)
        key = arr(i, 1) & "," & arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4)
        dic(key) = dic(key) & "," & arr(i, 6)
    Next
    keys = dic.keys
    items = dic.items
    Dim brr As Variant: ReDim brr(1 To dic.Count, 1 To 7)
    For i = LBound(keys, 1) To UBound(keys, 1)
        For j = 1 To 4
            brr(i + 1, j) = Split(keys(i), ",")(j - 1)
        Next j
        temp_time = Split(items(i), ",")
        brr(i + 1, 5) = temp_time(LBound(temp_time) + 1)
        brr(i + 1, 6) = temp_time(UBound(temp_time))
        brr(i + 1, 7) = Round(DateDiff("n", brr(i + 1, 5), brr(i + 1, 6)) / 60, 2)
    Next i
    ThisWorkbook.Sheets("4月份考勤记录").Range("H2").Resize(UBound(brr, 1), UBound(brr, 2)).Value = brr
End Sub