vba 自动排序_给VBA字典键值排序，并提取需要的数据

未知的领域很广、风景很美，不要蜷缩在一小块自认为天堂的世界里。待到暮年时安于自欺欺人，要努力提高自己，学习是一件很辛苦的事。要有一颗充满生机的心，把握现在，这才是进取。机会总在等待中出现，越是有意义的事情，困难会越多。愿力决定始终，智慧决定成败。寻找心灵的平静；不管遇到什么，都是风景。怀善心，做善事。看淡纷争，看轻得失。茶，满也好，少也好，不要计较；浓也好，淡也好，其中自有值得品的味道。把浮躁的心静下来，去感悟真实的时间，静下心，多学习，积累福报。保持快乐的心态，坚定且执着。学习有用的知识，经营自己，而不是天天混日子，也不是天天熬日子。为后疫情时代做知识的储备。在今后更加严峻的存量残杀世界中，为自己的生存进行知识的储备，特别是新知识的储备。

在取代OFFICE新的办公软件没有到来之前，谁能数据处理做到最为极致，谁就是王者。其中登峰至极的技能非VBA莫属！

今日继续和大家分享VBA编程中常用的常用“积木”过程代码。这些内容大多是我的经验的记录，来源于我多年的经验。最近代码多是出自”VBA数组与字典解决方案”教程，有一些朋友反映分享的内容不能很好的理解，可以参考这套资料的内容进行研读。今日分享的是第288期。

VBA过程代码288：利用工作表函数，对字典的键值按大小排序,并给出对应的键

Sub MyNZ ()

Dim ran

Sheets("60").Select

Set mydic = CreateObject("Scripting.Dictionary") '字典

TT = Cells(Rows.Count, 1).End(xlUp).Row

For Each ran In Sheets("60").Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)

If ran.Value <> "" Then

If Not mydic.exists(ran.Value) Then

mydic.Add ran.Value, 1 '需要注意此处要加VALUE

Else

mydic(ran.Value) = mydic(ran.Value) + 1

End If

'注意此处把字典的键和键值取出

K = mydic.keys: T = mydic.items

ReDim X(1 To mydic.Count, 1 To 2)

For i = 1 To mydic.Count

X(i, 1) = Application.Large(K, i) '按最大值的先后将数据放到数组中

X(i, 2) = mydic(X(i, 1)) '提取相应的键值

MYCOUNT = i - 1

Set mydic = Nothing

Set mydic = CreateObject("Scripting.Dictionary") '字典

For i = 1 To MYCOUNT

mydic(X(i, 1)) = X(i, 2)

K = mydic.keys: T = mydic.items

ReDim X(1 To mydic.Count, 1 To 2)

For i = 1 To mydic.Count

X(i, 2) = Application.Max(T)

'找到键的位置

W = Application.Match(X(i, 2), T, 0) - 1

'提取键

X(i, 1) = K(W)

'相应的键值变成空，以用MAX函数

T(W) = ""

[e:f].Clear

[E1] = "排序": [f1] = "重复次数"

Sheets("60").[E2].Resize(mydic.Count, 2) = X

Set mydic = Nothing

End Sub

代码解析：上述过程实现了把数据装入字典mydic，将数值放入字典的键，出现的次数放入键值中，然后把键及键值分别放入数组K,T中，注意是一维数组，然后对数值进行排序，用了large函数，排序完成后，再次装入字典，取出键和键值，此处这么处理的目的是获取一个一维数组，也可以用其他的处理方式，然后对键值进行排序，利用的是MAX函数，最后形成了先对数值出现次数的排序后对数值进行排序的结果，放到数组X中，最后回填数据。