敬请老师指教一下这代码错在哪里，D3合计总无法实现。

wtb8152

老师好！
敬请帮我看下这汇总代码错在哪里，或者这样写对不对，B3的合计代码无法运行，一运行就错误。敬请老师指教一下。谢谢！！

ykcbf1100

看懂你代码的时间，我新代码都写完了。

ykcbf1100

新写一个。

wtb8152

谢谢ykcbf1100老师顶力帮助！经常看到老师您在这平台上为人排忧解难，实为感动至极！向您叩谢啦了！！

wtb8152

ykcbf1100 发表于 2024-9-25 08:13
看懂你代码的时间，我新代码都写完了。

感谢ykcbf1100老师的顶力帮助！鄙人学艺不精，实在见笑了，常见老师在为人排忧解难，实在感动至极，谢谢啦！！

Qs18

1. Sub qs()
   
2. Dim arr, i, dic
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. With Sheet2
   
5. arr = .UsedRange.Value
   
6. End With
   
7. ReDim brr(1 To UBound(arr), 1 To 4)
   
8. With Sheet3
   
9. dt1 = CDate(.[a2].Value): dt2 = CDate(.[c2].Value)
   
10.     For i = 4 To UBound(arr)
    
11.         dt = CDate(arr(i, 1))
    
12.         If dt >= dt1 And dt <= dt2 Then
    
13.             s = arr(i, 3)
    
14.             If Not dic.exists(s) Then
    
15.                 m = m + 1
    
16.                 dic(s) = m
    
17.                 brr(m, 1) = s: brr(m, 2) = arr(i, 5)
    
18.                 brr(m, 3) = arr(i, 6): brr(m, 4) = brr(m, 2) - brr(m, 3)
    
19.             Else
    
20.                 rw = dic(s)
    
21.                 brr(rw, 2) = brr(rw, 2) + arr(i, 5): brr(rw, 3) = brr(rw, 3) + arr(i, 6):
    
22.                 brr(rw, 4) = brr(rw, 2) - brr(rw, 3)
    
23.             End If
    
24.         
    
25.         End If
    
26.     Next
    
27. .[b3].Value = Application.Sum(Application.Index(brr, 0, 2))
    
28. .[c3].Value = Application.Sum(Application.Index(brr, 0, 3))
    
29. .[d3].Value = Application.Sum(Application.Index(brr, 0, 4))
    
30. .[a5].Resize(m, 4) = brr
    
31. End With
    
32. Set dic = Nothing
    
33. Beep
    
34. End Sub
    

复制代码

Qs18

试试............

Qs18

试试...........