標題: VBA 用字典的方式提去不重複及小到大的排序 [打印本頁]

---

作者: kim223824    時間: 2017-11-24 11:27     標題: VBA 用字典的方式提去不重複及小到大的排序

各位大大:

請問如何用 VBA 中 用字典的方式 從小到大的排序

[attach]28023[/attach]

我只寫到不重複，排序就卡住了。
Sub text()
    Dim d As Object, arr, brr
    Set d = CreateObject("scripting.dictionary")
   
    arr = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
   
    ReDim brr(1 To UBound(arr), 1 To 1)
   
    For i = 1 To UBound(arr)
        s = arr(i, 1)
        If Not d.exists(s) Then
            d(s) = ""
            k = k + 1
            brr(k, 1) = arr(i, 1)
        End If
    Next
    Range("B:B").ClearContents
    Range("B1").Value = "結果"
    With Range("B2").Resize(k, 1)
        .NumberFormat = "@"
        .Value = brr
    End With
   
    Set d = Nothing
      
end sub

[attach]28024[/attach]

---

作者: joblyc017    時間: 2017-11-24 14:34

回復 1# kim223824

個人練習，數值從小到大排序，想到使用Small函數排序，詳下圖紅框：
    [attach]28026[/attach]

---

作者: adrian_9832    時間: 2017-11-25 14:55

或者用錄制巨集的功能 也行

---

作者: Kubi    時間: 2017-11-25 19:57

回復 1# kim223824
底下誠如3樓 adrian_9832 所說的是用錄製的方式取得：
Sub test()
    Columns("A").Copy [B1]
    er = [A65536].End(3).Row
    With Range("B1:B" & er)
        .RemoveDuplicates Columns:=1, Header:=xlNo
        .Sort key1:=[B1], Order1:=1
    End With
End Sub

---

作者: kim223824    時間: 2017-11-26 15:46

感謝各位大大:
提供的方法，結果一樣，我本來想用字典的語法，來完成這樣程式。

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)