[已解决]dsmch老师，有空帮我看看，谢谢。。

新一

红色底纹的三个表，其中表一，表二，每日的合计来源于总表，我想用VBA进行按日期合计，可否解决，谢谢。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-24 13:22

表二人名+工种+日期没有对应的结果

跳转到最佳答案楼层

dsmch

1. Sub Macro3()
   
2. Dim arr, brr, crr, d, i&, j%, k%, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a2").CurrentRegion
   
5. For i = 3 To UBound(arr)
   
6.     zf = arr(i, 8) & "," & arr(i, 4) & "," & arr(i, 1)
   
7.     d(zf) = arr(i, 7)
   
8. Next
   
9. For k = 1 To 2
   
10.     brr = Sheets(k).Range("a2:ak" & Sheets(k).Range("a65536").End(xlUp).Row)
    
11.     For i = 3 To UBound(brr)
    
12.         For j = 4 To UBound(brr, 2)
    
13.             zf = brr(i, 2) & "," & brr(i, 3) & "," & brr(1, j)
    
14.             brr(i, j) = d(zf)
    
15.         Next
    
16.     Next
    
17.     Sheets(k).Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
18. Next
    
19. End Sub
    

复制代码

dsmch

表二人名+工种+日期没有对应的结果

新一

dsmch 发表于 2014-4-24 13:22
表二人名+工种+日期没有对应的结果

表二+人名+日期，可否可以？

dsmch

点击工种按钮后执行代码
Sub Macro3()
Dim arr, brr, crr, d, i&, j%, k%, zf$
Set d = CreateObject("scripting.dictionary")
arr = Range("a2").CurrentRegion
For i = 3 To UBound(arr)
    zf = arr(i, 8) & "," & arr(i, 9) & "," & arr(i, 1)
    d(zf) = arr(i, 7)
Next
For k = 1 To 2
    brr = Sheets(k).Range("a2:ak" & Sheets(k).Range("a65536").End(xlUp).Row)
    For i = 3 To UBound(brr)
        For j = 4 To UBound(brr, 2)
            zf = brr(i, 2) & "," & brr(i, 3) & "," & brr(1, j)
            brr(i, j) = d(zf)
        Next
    Next
    Sheets(k).Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
Next
End Sub

新一

dsmch 发表于 2014-4-24 20:03
点击工种按钮后执行代码
Sub Macro3()
Dim arr, brr, crr, d, i&, j%, k%, zf$

老师，表一和表二，黄色区域设置合计公式，更新后公式不见了

新一

非常感谢