[已解决]请老师写个VBA，谢谢，在线等

star9s

请看附件，谢谢

最佳答案

月排行榜 / 总排行榜

france723

2017-5-3 23:08

star9s 发表于 2017-5-3 21:52
我可以由高至低排序好，能写VBA吗？在线等

f2:bn20000范围内数据全满

1. Sub bbb()
   
2. Sheets("Sheet1").Select
   
3. Dim d, br, c, k, n, m, s, j&, i&, t
   
4. br = Range("f2:bn20000")
   
5. Set d = CreateObject("scripting.dictionary")
   
6. For j = 1 To UBound(br)
   
7.     For c = 2 To 61
   
8.         d(br(j, 1)) = d(br(j, 1)) & "," & br(j, c)
   
9.     Next c
   
10. Next j
    
11. m = 1
    
12. For Each k In d.keys
    
13.     Sheets("Sheet2").Select
    
14.     For n = 1 To 10
    
15.         t = 0
    
16.         n = Mid(n, 1)
    
17.         Cells(n, m) = n
    
18.         s = Split(Mid(d(k), 2), ",")
    
19.         For i = 0 To UBound(s)
    
20.             If s(i) = n Then
    
21.                 t = t + 1
    
22.             End If
    
23.         Next i
    
24.         Cells(n, m + 1) = t
    
25.     Next n
    
26.     m = m + 3
    
27. Next k
    
28. End Sub

复制代码

跳转到最佳答案楼层

france723

F列的数据本身是无序的,还是由高到低已经排列好的

star9s

france723 发表于 2017-5-3 21:18
F列的数据本身是无序的,还是由高到低已经排列好的

无序的

star9s

france723 发表于 2017-5-3 21:18
F列的数据本身是无序的,还是由高到低已经排列好的

我可以由高至低排序好，能写VBA吗？在线等

france723

star9s 发表于 2017-5-3 21:52
我可以由高至低排序好，能写VBA吗？在线等

f2:bn20000范围内数据全满

1. Sub bbb()
   
2. Sheets("Sheet1").Select
   
3. Dim d, br, c, k, n, m, s, j&, i&, t
   
4. br = Range("f2:bn20000")
   
5. Set d = CreateObject("scripting.dictionary")
   
6. For j = 1 To UBound(br)
   
7.     For c = 2 To 61
   
8.         d(br(j, 1)) = d(br(j, 1)) & "," & br(j, c)
   
9.     Next c
   
10. Next j
    
11. m = 1
    
12. For Each k In d.keys
    
13.     Sheets("Sheet2").Select
    
14.     For n = 1 To 10
    
15.         t = 0
    
16.         n = Mid(n, 1)
    
17.         Cells(n, m) = n
    
18.         s = Split(Mid(d(k), 2), ",")
    
19.         For i = 0 To UBound(s)
    
20.             If s(i) = n Then
    
21.                 t = t + 1
    
22.             End If
    
23.         Next i
    
24.         Cells(n, m + 1) = t
    
25.     Next n
    
26.     m = m + 3
    
27. Next k
    
28. End Sub

复制代码

star9s

france723 发表于 2017-5-3 23:08
f2:bn20000范围内数据全满

可以帮我改一下把统计出来的依次排序到A列吗？