关于区间统计人数

桑榆非晚123

戎马书生222 发表于 2025-1-29 15:54
ai擅长使用cells

你可以让他优化，用数组。我现在很无语的是AI写VBA代码经常出现错误。用python就比较准确。可惜大家习惯于使用VBA。因为python还得额外安装。

戎马书生222

学习了ykcbf1100大侠的代码，用字典嵌套也还是可以的。第一行和第一列没有写代码，想用的自己写。

1. Sub test2()
   
2. Set d = VBA.CreateObject("scripting.dictionary")
   
3. arr = Sheets("sheet1").Range("a1").CurrentRegion
   
4. brr = Sheets("sheet1").Range("r1").CurrentRegion
   
5. crr = Sheets("结果").Range("a1").CurrentRegion
   
6. With Sheets("sheet1")
   
7.     For i = 2 To UBound(arr)
   
8.         s = arr(i, 1)
   
9.         Set d(s) = VBA.CreateObject("scripting.dictionary")
   
10.     Next i
    
11. 
    
12. For i = 2 To UBound(arr)
    
13.     s = arr(i, 1)
    
14.     For x = 2 To UBound(brr)
    
15.         ss = brr(x, 1)
    
16.         If x = UBound(brr) Then r1 = brr(UBound(brr), 2): r2 = 1000
    
17.          r1 = brr(x, 2): r2 = brr(x + 1, 2)
    
18.             If arr(i, 15) >= r1 And arr(i, 15) < r2 Then
    
19.             d(s)(ss) = d(s)(ss) + 1
    
20.             Exit For
    
21.             End If
    
22.     Next x
    
23. Next i
    
24. End With
    
25. drr = d.keys
    
26.     lastrow = d.Count + 1
    
27.     For i = 2 To lastrow
    
28.          For j = 2 To UBound(brr)
    
29.             crr(i, j) = d(crr(i, 1))(crr(1, j))
    
30.         Next j
    
31.     Next i
    
32.     Sheets("结果").Range("a1").Resize(d.Count + 1, UBound(brr)) = crr
    
33. End Sub

复制代码