用VBA统计个数,请高师赐教,谢谢

cjc209

我帮你翻译

徐海洋

feilanga 发表于 2025-10-31 09:56
有个工具叫VBA代码助手，一建释义

谢谢您,高师,您辛苦了

feilanga

徐海洋 发表于 2025-10-31 09:15
恩师,请您再帮我改一改,谢谢

套改一下呗。

徐海洋

feilanga 发表于 2025-10-31 10:31
套改一下呗。

非常谢谢高师的帮助,您辛苦了

gwjkkkkk

1. =REDUCE({"数字","个数"},UNIQUE(B3:B128),LAMBDA(x,y,VSTACK(x,HSTACK(y,COUNTIF(B3:B128,y)))))

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

1. Sub ykcbf()   '//2025.10.31
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     [f3:z1000].ClearContents
   
5.     arr = Range("b2").CurrentRegion.Value
   
6.     For j = 1 To UBound(arr, 2)
   
7.         d.RemoveAll
   
8.         For i = 2 To UBound(arr)
   
9.             If Len(arr(i, j)) Then
   
10.                 d(arr(i, j)) = d(arr(i, j)) + 1
    
11.             End If
    
12.         Next
    
13.         Set Rng = Cells(3, (j - 1) * 2 + 6).Resize(d.Count, 2)
    
14.         Rng.Value = WorksheetFunction.Transpose(Array(d.keys, d.Items))
    
15.         Rng.Sort Key1:=Rng.Columns(2), Order1:=1, Key2:=Rng.Columns(1), Order2:=1, Header:=xlNo
    
16.     Next
    
17.     Application.ScreenUpdating = False
    
18. End Sub
    

复制代码

micch

1. Private Sub CommandButton1_Click()
   
2.     Range("d3").Resize(11).Formula = "=row()-3"
   
3.     Range("E3").Resize(11).ClearContents
   
4.     r = 3
   
5.     While Len(Cells(r, 2).Value) > 0
   
6.         m = Cells(r, 2).Value
   
7.         Cells(m + 3, 5).Value = 1 + Cells(m + 3, 5).Value
   
8.         r = r + 1
   
9.     Wend
   
10. End Sub

复制代码

徐海洋

ykcbf1100 发表于 2025-10-31 12:53
附件供参考。。。

谢谢恩师,您辛苦了,简单明了,跟恩师学艺,不会都难,没花了,只能好评

rongqing1006

我都 没弄清楚怎么个统计法,楼主能说明一下不?这样我看懂啊