vba 统计数量 数据量大，用了"SUMPRODUCT"运行太慢

niwopy

vba 统计数量       数据量大，用了"SUMPRODUCT"运行太慢

swl4561255

1. Sub test()
   
2. Dim a As Range
   
3. Dim arr(1 To 100, 1 To 1)
   
4. For i = 10 To 23
   
5.     n = 0
   
6.     For Each a In Range("G10:N23")
   
7.         If a.Row <> i And a.Value >= Cells(i, a.Column) Then
   
8.             n = n + 1
   
9.         End If
   
10.     Next
    
11.     arr(i - 9, 1) = n
    
12. Next
    
13. [T10].Resize(UBound(arr), 1) = arr
    
14. End Sub
    

复制代码

ykcbf1100

在VBA版块呆久了，公式也看不明白了。

niwopy

于箱长

ykcbf1100 发表于 2024-5-6 14:20
在VBA版块呆久了，公式也看不明白了。

+1

ykcbf1100

于箱长 发表于 2024-5-6 14:44
+1

统计个数的？

niwopy

ykcbf1100 发表于 2024-5-6 14:51
统计个数的？

嗯 统计个数的

ykcbf1100

niwopy 发表于 2024-5-6 15:03
嗯 统计个数的

你用2楼的代码吧。

baofa2

1. Sub test0()
   
2.   Dim ar, br() As Long
   
3.   Dim i As Long, j As Long, k As Long, n As Double
   
4.   ar = Range("G10").CurrentRegion.Value
   
5.   ReDim br(1 To UBound(ar), 0)
   
6.   For i = 2 To UBound(ar)
   
7.     For j = 1 To UBound(ar, 2)
   
8.       n = Val(ar(i - 1, j))
   
9.       For k = i To UBound(ar)
   
10.         If Val(ar(k, j)) >= n Then br(i - 1, 0) = br(i - 1, 0) + 1
    
11.       Next
    
12.       n = Val(ar(i, j))
    
13.       For k = 1 To i - 1
    
14.         If Val(ar(k, j)) >= n Then br(i, 0) = br(i, 0) + 1
    
15.       Next
    
16.     Next
    
17.   Next
    
18.   Range("R10").Resize(UBound(br)) = br
    
19.   Beep
    
20. End Sub
    

复制代码

nihao123456789

1. Sub text()
   
2. Dim arr(1 To 14, 1 To 8) As Double
   
3. Dim r, l, result
   
4. For r = 1 To 14
   
5.   For l = 1 To 8
   
6.     arr(r, l) = Cells(r + 9, l + 6)
   
7.   Next l
   
8. Next r
   
9. 
   
10. For r = 1 To 14
    
11. result = 0
    
12.   For l = 1 To 8
    
13.     For r2 = 1 To 14
    
14.       If arr(r, l) <= arr(r2, l) And r <> r2 Then
    
15.        result = result + 1
    
16.       End If
    
17.     Next r2
    
18.   Next l
    
19. Cells(r + 9, 20) = result
    
20. Next r
    
21. 
    
22. End Sub

复制代码