|
楼主 |
发表于 2022-12-14 15:44
|
显示全部楼层
VBA中字典数据的排序-Excel VBA程序开发-ExcelHome技术论坛 - https://club.excelhome.net/thread-1102706-2-1.html
学习这个贴子后,扩展学习到Dictionary能记载Range数据特性。
- Sub del()
- Dim Rng As Range, ii, jj
- Dim Tmp, Str, Arr, Arr1
- Dim Dict As Dictionary
- Set Dict = New Dictionary
- For Each Rng In Sheet1.Range("A1:A10")
- Set Dict(Rng.Value) = Rng
- Next Rng
- With Dict
- Arr1 = .Items
- Arr = .Keys
- For ii = 0 To .Count - 1
- Set Rng = .Items(ii)
- 'Debug.Print Rng.Address, Rng
- Next ii
- ''
- End With
- Set Dict = DictionarySortOfRange(Dict)
- Stop
- With Dict
- For ii = 0 To .Count - 1
- Set Rng = .Items(ii)
- Debug.Print Rng.Address, Rng.Value, .Keys(ii)
- Next ii
- End With
- End Sub
- Function DictionarySortOfRange(Dict As Dictionary)
- ''
- Dim Arr, ii, jj, Tmp
- Dim Rng As Range
- With Dict
- Arr = .Keys
- For ii = 0 To .Count - 1
- Set Rng = .Items(ii)
- 'Debug.Print Rng.Address, Rng
- Next ii
- ''
- For ii = 1 To .Count '- 1
- For jj = 1 To .Count - 1
- 'Debug.Print Dict(Arr(ii)), Dict(Arr(jj))
- If Dict(Arr(ii - 1)) > Dict(Arr(jj - 1)) Then
- Set Tmp = Dict(Arr(ii - 1))
- Set Dict(Arr(ii - 1)) = Dict(Arr(jj - 1))
- Set Dict(Arr(jj - 1)) = Tmp
- End If
- Next jj
- Next ii
- End With
- Set DictionarySortOfRange = Dict
- End Function
复制代码 |
|