新手求指教excel 遍历sheet后如何统计工时相加

posxb520

本人最近才开始接触的excel vba，因工作需要，需要做一个员工的工时统计表，把每个员工一个月内工作过的时间全部加起来，所以一共需要分31天的工作表，然后再一次性汇总到工时统计表上。

可是由于名字在填写时不一定按顺序排行，因此没办法直接使用sum的公式完成表格，而是需要先把每个工作表上的名字和工时统计表上的名字对应后，在把同一名字的人的工时全部相加来完成。

我想到了用遍历sheet的方式把每个工作表都循环一次，却只做到了把每个表的姓名和工时统一并相加，问题是没办法把31个表格之间的姓名和工时统一并相加。

sub test()

for each sht in worksheet

        if sht.name like "*" & "号" then

                with sht

                for a = 6 to sheet1.range("f65533").end(xlup).row

                        for b = 8 to sheet2.range("e65533").end(xlup).row

                                if len(sheet1.cells(a,"F"))>0 and len(.cells(b,"E"))>0 and sheet1.cells(a,"F") = .cells(b,"E") then

                        c = c + .cells(b,"G").value

                        sheet1.cells(a,"G").value = c

                                end if

                        next

                c = 0

                next

                sht.activate

                end with

        end if

next

end sub

想请教一下如何把sheet之间的工时统计起来，汇总到对应的姓名上，或者有另外更好的办法！！

posxb520

楼下上传文档

posxb520

漏了上传excel了抱歉

abc123281

这个需要用到字典对应   但是没看到你的附件

东东6666

可以把你统一好格式的多张表汇总一张表，代码如下可以实现，汇总前要备份（有删除功能，以前写的代码没修改，针对不同数据格式运行也许会有错误，自行修改一下）

Sub 汇总()
'汇总
Dim i, j, k, m, n As Integer
Dim sht As Worksheet
i = Sheets.Count
'判断表数
If i < 2 Then
MsgBox "1张表就不用汇总啦", , "温馨提示"
Exit Sub
End If
'提示
n = MsgBox("确定要汇总数据吗？", 1, "温馨提示")
If n = 2 Then
Exit Sub
End If
'删表
For Each sht In Sheets
    If i < 2 Then
    Exit For
    End If
    If sht.Range("a1") = "" Then
    Application.DisplayAlerts = False
    sht.Delete
    Application.DisplayAlerts = True
    End If
Next
'建汇总
If Sheets.Count < 1 Then
Exit Sub
End If
'避免建同名表
If Sheets(1).Name = "汇总" Then
    Sheets(1).Cells.Select
    Selection.ClearContents
Else
Sheets.Add before:=Sheets(1)
Sheets(1).Name = "汇总"
End If


j = Sheets.Count - 2
    '第一次带表头复制
    Sheets(2).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets(1).Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.DisplayAlerts = False
    Sheets(2).Delete
    Application.DisplayAlerts = True
    '后续循环复制
    For k = 1 To j
    On Error Resume Next
        i = Sheets(1).Range("a56636").End(xlUp).Row
        Sheets(2).Select
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets(1).Select
        Range("A" & i + 1).Select
        ActiveSheet.Paste
        Application.DisplayAlerts = False
        Sheets(2).Delete
        Application.DisplayAlerts = True
    Next
Sheets(1).Range("a1").Select
End Sub

lsc900707

用字典统计。

posxb520

谢谢谢谢各位了，回头在电脑上试一下

posxb520

朱荣兴 发表于 2018-4-3 08:17
典型的字典求和

新手刚学的看不太懂，需要慢慢消化，太感谢你了

posxb520

朱荣兴 发表于 2018-4-3 08:17
典型的字典求和

想请教一下从 t = d(arr(i, 1)) 开始后面是什么意思，看不懂不好意思