统计数字个数,请高师赐教,谢谢

quqiyuan

代码如下。。。
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    tm = Timer
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    arr = Me.[b3].CurrentRegion
    brr = Me.[i3].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            s = arr(i, j)
            If s <> Empty Then d(s) = d(s) + 1
        Next
    Next
    Set dic = CreateObject("scripting.dictionary")
    For i = 2 To UBound(brr)
        For j = 1 To UBound(brr, 2)
            s = brr(i, j)
            If s <> Empty Then dic(s) = dic(s) + 1
        Next
    Next
    Me.[s3].Resize(1000, 4).ClearContents
    Me.[s3].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    Set Rng = Me.[s3].Resize(d.Count, 2)
    Me.Sort.SortFields.Clear
    Me.Sort.SortFields.Add2 Key:=Rng.Cells(1, 2), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
    With Me.Sort
        .SetRange Rng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Me.[u3].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
    Set Rng = Me.[u3].Resize(dic.Count, 2)
    Me.Sort.SortFields.Clear
    Me.Sort.SortFields.Add2 Key:=Rng.Cells(1, 2), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
    With Me.Sort
        .SetRange Rng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "共耗时：" & Format(Timer - tm, "0.0000") & " 秒！！！", 64
End Sub

liulang0808

徐海洋 发表于 2025-11-3 14:43
谢谢高师,怎么不一样,个数按从小到大排列

录制了一段排序代码，排序即可的

徐海洋

ykcbf1100 发表于 2025-11-3 14:51
附件供参考。。。

谢谢恩师,您辛苦了,谢谢您的大恩大德

gwjkkkkk

1. =LET(a,TOCOL(B3:G15,1),SORT(DROP(REDUCE("",UNIQUE(a),LAMBDA(x,y,VSTACK(x,HSTACK(y,ROWS(FILTER(a,a=y)))))),1),2))

复制代码

1. =LET(a,TOCOL(I3:N15,1),SORT(DROP(REDUCE("",UNIQUE(a),LAMBDA(x,y,VSTACK(x,HSTACK(y,ROWS(FILTER(a,a=y)))))),1),2))

复制代码

写个高版本公式

徐海洋

gwjkkkkk 发表于 2025-11-3 19:46
写个高版本公式

恩师,公式是WPS用的吗?,EXCEL用不了

gwjkkkkk

徐海洋 发表于 2025-11-3 22:15
恩师,公式是WPS用的吗?,EXCEL用不了

对的，wps公式

今铭昔

徐海洋

今铭昔 发表于 2025-11-4 07:53

这是怎么做的?

cjc209

今铭昔 发表于 2025-11-4 07:53

你的还是自定义jsa函数吗?

cjc209

今铭昔 发表于 2025-11-4 07:53

你的是Python吗?