求助VBA取最大及求和（可能有些难度）

3190496160

dailj 发表于 2022-11-26 20:58
大佬，如果这个最大日期不是在最后一行，有办法取日期最大值吗？如果要取最大值，会不会影响运行效率？

目前的代码速度应该是最快的，如果日期不是在最后一行就得增加循环速度肯定就大打折扣了呀

dailj

3190496160 发表于 2022-11-26 21:09
目前的代码速度应该是最快的，如果日期不是在最后一行就得增加循环速度肯定就大打折扣了呀

大佬真腻害！非常感谢！

3190496160

dailj 发表于 2022-11-26 20:58
大佬，如果这个最大日期不是在最后一行，有办法取日期最大值吗？如果要取最大值，会不会影响运行效率？

突然想到一个不用增加循环，只要增加一个判断条件的办法，可以做到最大日期不在最后一行也能取到最大日期的办法了，

1. Sub 取数()
   
2. Application.ScreenUpdating = False
   
3. Dim ar As Variant
   
4. Dim d As Object
   
5. Dim br()
   
6. Set d = CreateObject("scripting.dictionary")
   
7. With Sheet1
   
8.     r = .Cells(Rows.Count, 2).End(xlUp).Row
   
9.     ar = .Range("a1:e" & r)
   
10.     ReDim br(1 To 100000, 1 To 3)
    
11.     For i = 2 To UBound(ar)
    
12.         If Trim(ar(i, 2)) <> "" Then
    
13.             If InStr(ar(i, 3), ",") = 0 Then
    
14.                 zf = ar(i, 2) & ar(i, 3)
    
15.                 t = d(zf)
    
16.                 If t = "" Then
    
17.                     k = k + 1
    
18.                     d(zf) = k
    
19.                     t = k
    
20.                     br(k, 1) = zf
    
21.                     br(k, 2) = ar(i, 4)
    
22.                 End If
    
23.                 br(t, 3) = br(t, 3) + ar(i, 5)
    
24.                 If br(k, 2) < ar(i, 4) Then br(t, 2) = ar(i, 4)
    
25.             ElseIf InStr(ar(i, 3), ",") > 0 Then
    
26.                 rr = Split(ar(i, 3), ",")
    
27.                 sl = UBound(rr) + 1
    
28.                 For s = 0 To UBound(rr)
    
29.                     zf = ar(i, 2) & rr(s)
    
30.                     t = d(zf)
    
31.                     If t = "" Then
    
32.                         k = k + 1
    
33.                         d(zf) = k
    
34.                         t = k
    
35.                         br(k, 1) = zf
    
36.                         br(k, 2) = ar(i, 4)
    
37.                     End If
    
38.                     If br(k, 2) < ar(i, 4) Then br(t, 2) = ar(i, 4)
    
39.                     br(t, 3) = br(t, 3) + (ar(i, 5) / sl)
    
40.                 Next s
    
41.             End If
    
42.         End If
    
43.     Next i
    
44.     rs = .Cells(Rows.Count, 7).End(xlUp).Row
    
45.     .Range("g2:i" & rs + 1).Borders.LineStyle = 0
    
46.     .Range("g2:i" & rs + 1) = Empty
    
47.     .[g2].Resize(k, UBound(br, 2)) = br
    
48.     .[g2].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
    
49. End With
    
50. Application.ScreenUpdating = True
    
51. MsgBox "ok!"
    
52. End Sub
    

复制代码

3190496160

突然想到一个不用增加循环，只要增加一个判断条件就可以做到最大日期不在最后一行也能取值的办法，测试看看吧
样本1.rar (20.91 KB, 下载次数: 12)

2022-11-27 11:07 上传

点击文件名下载附件

dailj

3190496160 发表于 2022-11-27 11:00
突然想到一个不用增加循环，只要增加一个判断条件的办法，可以做到最大日期不在最后一行也能取到最大日期 ...

太棒了，超出我的预期啦！我好崇拜你呀

dailj

3190496160 发表于 2022-11-27 11:07
突然想到一个不用增加循环，只要增加一个判断条件就可以做到最大日期不在最后一行也能取值的办法，测试看看 ...

经过测试，两个都很完美！今天没鲜花了，还是感谢大佬

准提部林

字典//非常規
Xl0000245.rar (13.24 KB, 下载次数: 16)

2022-11-27 16:22 上传

点击文件名下载附件

jz_l

dailj

准提部林 发表于 2022-11-27 16:23
字典//非常規

确实是非常规，我要好好学习了运行效率好高，今日没鲜花了，感谢大佬

dailj

jz_l 发表于 2022-11-27 16:56

看懂了，这么耐心给我注释，非常感谢帮助，3Q