各位老师，帮忙看看两段代码能不能合起来

无关岁月

算是提供另外一种思路吧

去重计数 - 副本.7z (22.92 KB, 下载次数: 5)

2024-3-21 09:36 上传

点击文件名下载附件

zhangcheng6688

无关岁月 发表于 2024-3-21 09:36
算是提供另外一种思路吧

老师在，空了时候能不能帮我看一下这个帖子，https://club.excelhome.net/thread-1688132-2-1.html 第11楼
学习老师的代码写的，但是出来的结果好像和公式不一样，感觉代码也没什么问题。先谢谢了。

无关岁月

zhangcheng6688 发表于 2024-3-31 08:01
老师在，空了时候能不能帮我看一下这个帖子，https://club.excelhome.net/thread-1688132-2-1.html 第11 ...

差条件

zhangcheng6688

无关岁月 发表于 2024-3-31 08:23
差条件

收到，到时再来研究

shiruiqiang

学习sql语句，目前感觉比字典稍微简单

zhangcheng6688

无关岁月 发表于 2024-3-31 08:23
差条件

理解了，谢谢老师

阿xia

Sub safd()


Dim arr(), arr2(), arr3()
Dim myDict As Object

Set myDict = CreateObject("Scripting.Dictionary")

col1 = Cells(Rows.Count, 2).End(xlUp).Row - 1

arr = Cells(2, 1).Resize(col1, 1).Value

For i = 1 To UBound(arr)

    j = arr(i, 1)

    If myDict.Exists(j) Then
      
       myDict(j) = myDict(j) + 1
    Else
   
        
        myDict(j) = 1
        
    End If

Next i

arr2 = myDict.Keys
arr3 = myDict.Items
Range("d1").Resize(myDict.Count, 1) = WorksheetFunction.Transpose(arr2)
Range("e1").Resize(myDict.Count, 1) = WorksheetFunction.Transpose(arr3)

End Sub