有赏求助，把每日工资自动填入到工资表中对应的人员每日工资中，谢谢

dantemis

有赏求助，请把每日表中的总提成工资自动填入到工资表中对应的人员每日工资中，谢谢

附件中每日的工资表是从系统导出的，格式不是我需要的，厂家不可以定制更改，所以每次做工资表要打开每天的表来复制粘贴非常的繁锁还出错，麻烦大神们帮我做一个整合，把附件中的每天总提成自动填入总表中对应的日期中去，其中人员会出现离职和新增，如出现则自动在总表中加入新人对应操作即可，万分感谢！！！

3190496160

可以加v，zrx11114，风絮

dantemis

3190496160 发表于 2024-11-21 20:26
可以加v，zrx11114，风絮

好的，       加了

dantemis

哪位大神帮帮忙，谢谢

3190496160

Sub 汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
With ActiveSheet
     .Range("d5:o30") = Empty
    ar = .Range("a3:o30")
    For i = 3 To UBound(ar)
        If ar(i, 2) <> "" And ar(i, 3) <> "" Then
            s = ar(i, 2) & "|" & ar(i, 3)
            d(s) = i
        End If
    Next i
    For j = 4 To UBound(ar, 2)
        If ar(1, j) <> "" Then
            ss = ar(1, j)
            d(ss) = j
        End If
    Next j
    f = Dir(lj & "*.xls*")
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(lj & f, 0)
            With wb.Worksheets(1)
                r = .Cells(Rows.Count, 2).End(xlUp).Row
                br = .Range("a3:l" & r)
                rq = Day(Split(.[a2], "至")(0))
            End With
            wb.Close False
            For i = 2 To UBound(br)
                s = br(i, 2) & "|" & br(i, 3)
                xh = d(s)
                lh = d(rq)
                If xh <> "" And lh <> "" Then
                    ar(xh, lh) = br(i, 12)
                End If
            Next i
        End If
    f = Dir
    Loop
    .Range("a3:o30") = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

GZ.rar (40.22 KB, 下载次数: 1)

2024-11-25 09:38 上传

点击文件名下载附件

3190496160

是否v搞错了，我这里没看到加好友的

dantemis

3190496160 发表于 2024-11-25 09:38
是否v搞错了，我这里没看到加好友的

我加的你留言的这个zrx11114

dantemis

3190496160 发表于 2024-11-25 09:38

真的要非常感谢您的帮忙，只是我下载你的附件文件不能打开，我复制代码去表执行试看看哦，谢谢，

3190496160

dantemis 发表于 2024-11-25 19:34
我加的你留言的这个zrx11114

zrx114114，你少了一个4吧