[µo°Ý] VBA ½Ð°Ý¦r¼Æ+¦r¥À±Æ§Ç«ç»ò°µ

s13030029

¦p¹Ï©Ò¥Ü¡A½Ð°Ý­n¦p¦ó¹F¨ì¦r¼Æ¤Ö¨ì¦h¡A¦A¨Ì¦r¥ÀA-Z¶i¦æ±Æ§Ç

2020-10-14 14:07

ªþÀÉ test.rar (13.99 KB)

¤U¸ü¦¸¼Æ: 25

2020-10-14 14:08

ikboy

1. Sub zz()
   
2. Dim a, b, c As Object, d As Object, i&, j&, n&, k
   
3. Set d = CreateObject("scripting.dictionary")
   
4. a = Range("a2:a" & [a65536].End(3).Row).Value
   
5. ReDim aa(1 To UBound(a))
   
6. For Each b In a
   
7.     n = Len(b)
   
8.     d(n) = d(n) & "|" & b
   
9. Next
   
10. k = d.keys
    
11. With Application
    
12.     For i = 1 To d.Count
    
13.         n = .Small(k, i)
    
14.         t = Split(Mid(d(n), 2), "|")
    
15.         Set c = CreateObject("system.collections.arraylist")
    
16.         For Each b In t
    
17.             c.Add b
    
18.         Next
    
19.         c.Sort
    
20.         For Each b In c
    
21.             j = j + 1
    
22.             a(j, 1) = b
    
23.         Next
    
24.     Next
    
25. End With
    
26. [d2].Resize(j) = a
    
27. End Sub

½Æ»s¥N½X

s13030029

¦^´_ 2# ikboy
¤Ó¯«°Õ!!!
ÁÂÁ¤j¤j~

samwang

1. Sub tt()
   
2. Dim Arr, Brr, n&
   
3. n = [A65536].End(xlUp).Row
   
4. With [B2].Resize(n - 1)
   
5.     .Formula = "=LEN(A2)"
   
6.     .Value = .Value
   
7. End With
   
8. 
   
9. With Range([A1], [B65536].End(xlUp))
   
10.     Brr = .Value
    
11.     .Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlYes
    
12.     Arr = .Value
    
13.     .Value = Brr
    
14. End With
    
15. 
    
16. [d1].Resize(UBound(Arr)) = Arr
    
17. Range("B2:B" & n) = ""
    
18. End Sub

½Æ»s¥N½X

hcm19522

https://blog.xuite.net/hcm195222/blog/589409936

­ã´£³¡ªL

Sub TEST()
With Range([B1], [A65536].End(xlUp))
     .Columns(2) = "=LEN(A1)"
     .Sort Key1:=.Item(2), Order1:=xlAscending, _
           Key2:=.Item(1), Order2:=xlAscending, Header:=xlYes
     .Columns(2).ClearContents
End With
End Sub

Scott090

¦^´_ 6# ­ã´£³¡ªL

¾Ç¨ì¤@­Ó«ä¦ÒÅÞ¿è

   ÁÂÁÂ