Board logo

標題: [發問] VBA 請問字數+字母排序怎麼做 [打印本頁]
作者: s13030029    時間: 2020-10-14 14:09     標題: VBA 請問字數+字母排序怎麼做

如圖所示，請問要如何達到字數少到多，再依字母A-Z進行排序

[attach]32617[/attach]

附檔[attach]32618[/attach]
作者: ikboy    時間: 2020-10-14 16:26

本帖最後由 ikboy 於 2020-10-14 16:36 編輯
  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
複製代碼
作者: s13030029    時間: 2020-10-14 16:54

回復 2# ikboy
太神啦!!!
謝謝大大~
作者: samwang    時間: 2020-10-15 08:33

  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

  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

  16. [d1].Resize(UBound(Arr)) = Arr
  17. Range("B2:B" & n) = ""
  18. End Sub
複製代碼
作者: hcm19522    時間: 2020-10-15 12:06

https://blog.xuite.net/hcm195222/blog/589409936
作者: 准提部林    時間: 2020-10-15 20:37

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    時間: 2020-10-16 08:24

回復 6# 准提部林

學到一個思考邏輯

   謝謝
作者: s13030029    時間: 2020-10-16 10:39

本帖最後由 s13030029 於 2020-10-16 10:46 編輯

回復 6# 准提部林
整個縮短很多是沒錯，但是如果我旁邊欄已經有其他資料了，沒辦法在旁邊計算Len()的話要怎麼改???
PS.因為有寫其他程式碼，不方便再做欄位更動
作者: 准提部林    時間: 2020-10-16 19:08

回復 8# s13030029

邏輯都一樣, 變通一下即可:
[attach]32619[/attach]
作者: s13030029    時間: 2020-10-17 10:42

回復 9# 准提部林
准大 Sorry~ 可能我沒有說的很詳細
就是說我只有單純產品編號那欄要重新排序，其他欄的資料不需要一起變動~
作者: 准提部林    時間: 2020-10-17 12:07

回復 10# s13030029

Sub TEST_A3()
Dim R&, Arr, LN&
R = Cells(Rows.Count, 1).End(xlUp).Row
If R < 3 Then Exit Sub
With Range("A2:A" & R)
     Arr = .Value
     For i = 1 To .Count
         LN = Len(Arr(i, 1))
         Arr(i, 1) = 100 + IIf(LN = 0, 99, LN) & "|" & Arr(i, 1)
     Next i
     .Value = Arr
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
     .Replace "*|", "", Lookat:=xlPart
End With
End Sub
作者: s13030029    時間: 2020-10-19 09:04

回復 11# 准提部林
謝謝 准大~這是我要的~感恩
就是說先做字數剖析存到陣列再依字母排列
作者: 准提部林    時間: 2020-10-19 09:57

回復 12# s13030029


G03 >> 3個字 >> 變成 103|G03
FK2156 同理變成 106|FK2156
空白 則 變成 199|

即可依字數排序, 且空白的排到最後, 再將"*|"之前的數字替換為空!
作者: s13030029    時間: 2020-11-6 11:57

回復 13# 准提部林
准大您好~
我有新的問題想請教，就是說我的產品編號有 "OAE-008-3" 這種的
如果要做字母及編號大小排序的話要怎麼改?
排序前                         排序後
A001                              A001
B001                              B001
OCB-001                     OAE-007-1
OBB-001                      OAE-008-2
OAE-008-3                 OAE-008-3
OAE-012                     OAE-012
OAE-007-1                 OBB-001
OAE-008-2                 OCB-001
作者: 准提部林    時間: 2020-11-6 13:01

回復 14# s13030029

看文字有規律, 直接排序不行嗎???
或者有其它狀況, 上傳檔案看看~~
作者: s13030029    時間: 2020-11-6 17:20

回復 15# 准提部林
因為之前是依字數所以OAE-008-3這種較長的會在最後
作者: 軒云熊    時間: 2020-11-6 20:15

回復 16# s13030029
看起來 結果是 一樣的 一般排序也可以
Range(Cells(Rows.Count, 1).End(xlDown), Cells(2, 1)).Sort Cells(2, 1)
作者: samwang    時間: 2020-11-9 08:26

回復 14# s13030029

借用准大修改如下
Sub TEST()
Dim R&, Arr, LN&
R = Cells(Rows.Count, 1).End(xlUp).Row
If R < 3 Then Exit Sub
With Range("A2:A" & R)
    Arr = .Value
    For i = 1 To .Count
        ipos = InStr(5, Arr(i, 1), "-")
        If ipos > o Then
            xR = Mid(Arr(i, 1), 1, ipos - 1)
            Arr(i, 1) = 100 + IIf(LN = 0, 99, ipos - 1) & "|" & Arr(i, 1)
        Else
            LN = Len(Arr(i, 1))
            Arr(i, 1) = 100 + IIf(LN = 0, 99, LN) & "|" & Arr(i, 1)
        End If
      Next i
      .Value = Arr
      .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
      .Replace "*|", "", Lookat:=xlPart
End With
End Sub
作者: s13030029    時間: 2020-11-9 08:47

回復 18# samwang
謝謝大大解決了我的問題~~感激不盡!!
作者: Andy2483    時間: 2023-6-6 15:10

回復 11# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,將方案設計為同字數後再排序,學習方案如下,請前輩再指導

前輩指導的方法:
[attach]36530[/attach]

後學延伸學習的方法:
[attach]36531[/attach]


Option Explicit
Sub TEST_A4()
Dim R&, Arr, LN&, i&
R = Cells(Rows.Count, 1).End(xlUp).Row
If R < 3 Then Exit Sub
With Range("A2:A" & R)
     Arr = .Value
     For i = 1 To .Count
         LN = 10 - Len(Arr(i, 1))
         Arr(i, 1) = Application.Rept("|", LN) & Arr(i, 1)
     Next i
     .Value = Arr
     .Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
     .Replace "|", "", Lookat:=xlPart
End With
End Sub



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