求助代码

1吧吧

人员出现次数    求助代码

沈默00

函数更为简单一些，，
=SORT(HSTACK(UNIQUE(TOCOL(B1:K2,1)),COUNTIF(B1:K2,UNIQUE(TOCOL(B1:K2,1)))),2,-1)

沈默00

沈默00

字典基础操作...

quqiyuan

参与一下。。。。

ykcbf1100

字典经典用法之一

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.17
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = Sheets("Sheet1").[b1:k2]
   
4.     ReDim brr(1 To 1000, 1 To 2)
   
5.     For Each k In arr
   
6.         If k <> Empty Then d(k) = d(k) + 1
   
7.     Next
   
8.     With Sheets("Sheet12")
   
9.         .UsedRange = ""
   
10.         .[b1].Resize(d.Count, 2) = WorksheetFunction.Transpose(Array(d.keys, d.items))
    
11.         .[b1].Resize(d.Count, 2).Sort .[b1], 1
    
12.     End With
    
13.     MsgBox "OK！"
    
14. End Sub
    

复制代码

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = Sheet1.[b1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
   For j = 1 To UBound(arr, 2)
      If arr(i, j) <> "" Then
         d(arr(i, j)) = d(arr(i, j)) + 1
      End If
   Next
Next
brr = Application.WorksheetFunction.Transpose(Array(d.keys, d.items))
For i = 1 To UBound(brr)
   For j = i + 1 To UBound(brr)
      If brr(i, 2) < brr(j, 2) Then
         temp = brr(i, 1): temp1 = brr(i, 2)
         brr(i, 1) = brr(j, 1): brr(i, 2) = brr(j, 2)
         brr(j, 1) = temp: brr(j, 2) = temp1
      End If
   Next
Next
Sheet2.[b1].Resize(UBound(brr), 2) = brr
End Sub

lushang2018

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, arr, brr
   
3.     Dim dic As Object, key, keys
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     arr = Sheet1.Range("A1").CurrentRegion
   
6.     For i = 1 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2)
   
8.             If arr(i, j) <> "" Then
   
9.                 key = arr(i, j)
   
10.                 dic(key) = dic(key) + 1
    
11.             End If
    
12.         Next
    
13.     Next
    
14.     keys = dic.keys
    
15.     ReDim brr(1 To dic.Count, 1 To 2)
    
16.     For i = 1 To dic.Count
    
17.         brr(i, 1) = keys(i - 1)
    
18.         brr(i, 2) = dic.items()(i - 1)
    
19.     Next
    
20.     Sheets("sheet12").Range("B1").Resize(dic.Count, 2) = brr
    
21. End Sub
    

复制代码