求助修改代码求助修改代码

1吧吧

求助修改代码

ykcbf1100

其实，加个排序语句就行了。

ykcbf1100

统计加排序

1. Sub test1()  '//2024.8.14
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheets("Sheet2").Range("B1:J" & Sheets("Sheet2").UsedRange.Rows.Count)
   
4.     Dim br()
   
5.     ReDim br(1 To 900000, 1 To 2)
   
6.     For i = 1 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2)
   
8.             If arr(i, j) <> "" Then
   
9.                 s = arr(i, j)
   
10.                 d(s) = d(s) + 1
    
11.             End If
    
12.         Next j
    
13.     Next i
    
14.     For Each k In d.keys
    
15.         m = m + 1
    
16.         br(m, 1) = k
    
17.         br(m, 2) = d(k)
    
18.     Next
    
19.     With Sheets("Sheet3")
    
20.         .Columns("b:c") = Empty
    
21.         .[b1].Resize(m, 2) = br
    
22.         Set Rng = .[b1].Resize(m, 2)
    
23.         Rng.Sort Rng.Cells(1, 2), 2
    
24.     End With
    
25. End Sub
    

复制代码

gwjkkkkk

请参考附件。。。

小凡、、、

需要精准的话可以写个数组排序，这样出来结果不一定准确

lsc900707

测试参考附件：

1吧吧