求助修改代码

lzqmsy

奖金台帐.rar (18.99 KB, 下载次数: 4)

2019-3-20 09:16 上传

点击文件名下载附件

lzqmsy

石沉大海,版主们都到哪里去了?

wzsy2_mrf

1. Sub 字典奖金汇总()
   
2.     Dim d As Object, r%, i%, arr, brr1, brr2, mkey, jd%, srr, r1&, r2&
   
3.     tt = Timer
   
4.     jd = Sheet2.[B3].Value
   
5.     arr = Sheet1.[A1].CurrentRegion
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     For i = 2 To UBound(arr)
   
8.         If Month(arr(i, 1)) >= jd * 3 - 2 And Month(arr(i, 1)) <= jd * 3 Then
   
9.             d(arr(i, 2)) = d(arr(i, 2)) & "++" & i
   
10.             d(arr(i, 2) & "++" & arr(i, 3)) = d(arr(i, 2) & "++" & arr(i, 3)) & "++" & i
    
11.         End If
    
12.     Next
    
13.     ReDim brr1(1 To d.Count, 1 To 4): ReDim brr2(1 To d.Count, 1 To 3)
    
14.     r1 = 1: r2 = 1
    
15.     For Each mkey In d.keys
    
16.         If InStr(mkey, "++") > 0 Then
    
17.             '处理1
    
18.             srr = Split(d(mkey), "++")
    
19.             brr1(r1, 1) = Split(mkey, "++")(0)
    
20.             brr1(r1, 2) = Split(mkey, "++")(1)
    
21.             For i = 1 To UBound(srr)
    
22.                 brr1(r1, 3) = brr1(r1, 3) + arr(srr(i), 4)
    
23.                 brr1(r1, 4) = brr1(r1, 4) + jianjin(Val(arr(srr(i), 4)))
    
24.             Next
    
25.             r1 = r1 + 1
    
26.         Else
    
27.             '处理2
    
28.             brr2(r2, 1) = mkey
    
29.             srr = Split(d(mkey), "++")
    
30.             For i = 1 To UBound(srr)
    
31.                 brr2(r2, 2) = brr2(r2, 2) + arr(srr(i), 4)
    
32.                 brr2(r2, 3) = brr2(r2, 3) + jianjin(Val(arr(srr(i), 4)))
    
33.             Next
    
34.             r2 = r2 + 1
    
35.         End If
    
36.     Next
    
37.     With Sheet2
    
38.         .Range("a5").Resize(10000, 4).Clear
    
39.         .Range("a5").Resize(r2, 3) = brr2
    
40.         .Range("a" & r2 + 10).Resize(r1, 4) = brr1
    
41.     End With
    
42. End Sub
    
43. Function jianjin(ms#) As Double
    
44.     If ms >= 100000 Then
    
45.         jianjin = 2000
    
46.     ElseIf ms >= 50000 Then
    
47.         jianjin = 1000
    
48.     ElseIf ms >= 10000 Then
    
49.         jianjin = 500
    
50.     Else
    
51.         jianjin = 0
    
52.     End If
    
53. End Function
    

复制代码

lzqmsy

wzsy2_mrf 发表于 2019-3-21 20:07

谢谢您的回复,我好好学一下,谢谢!!!

lzqmsy

wzsy2_mrf 发表于 2019-3-21 20:07

不能实现我的汇总要求,但是还要谢谢你,感谢!感谢!!!