返回列表 上一主題 發帖

[發問] Bubblesort 的迷思在文字+數值格式時?

[發問] Bubblesort 的迷思在文字+數值格式時?

各位大大,這個問題我查了蠻久了但始終沒辦法單用VBA解決(目前用split然後再由後面數值用Bubblesort),功力不夠...
如果單純用Bubblesort排出來像醬:
javascript:;javascript:;

常常遇到  文字+"-"或"/"或"#" 的格式,困擾蠻久的,有大大也遇過這種問題嗎? 麻煩提點一下,感激不盡^^

圖片 20150621124951.png (6.7 KB)

詭異的排列

圖片 20150621124951.png

Bubblesort.rar (13.21 KB)

回復 1# ui123

給你參考看看
  1. Sub ex() '格式化文字,將數字變成固定長度文字補00
  2. Debug.Print Format("62", "0000")
  3. Debug.Print Format("00062", "####")
  4. End Sub
複製代碼

TOP

回復 1# ui123


    先文字排序,再數字排序
應該可以達成你要的效果!
  1. Sub Bubblesort()
  2. Dim i, j  As Integer
  3. Dim arr, si, sj, s As Variant
  4. arr = Range("a4:a" & Cells(Rows.Count, 1).End(xlUp).Row)
  5. For i = 1 To UBound(arr)
  6.     For j = i + 1 To UBound(arr)
  7.         If arr(i, 1) > arr(j, 1) Then
  8.             s = arr(i, 1)
  9.             arr(i, 1) = arr(j, 1)
  10.             arr(j, 1) = s
  11.         End If
  12.     Next
  13. Next
  14. For i = 1 To UBound(arr)
  15.     For j = i + 1 To UBound(arr)
  16.             si = Split(arr(i, 1), "-")
  17.             sj = Split(arr(j, 1), "-")
  18.             If si(0) = sj(0) Then
  19.                 If si(1) + 1 > sj(1) + 1 Then '+1是讓"文字型的數字"變為"數字"
  20.                     s = arr(i, 1)
  21.                     arr(i, 1) = arr(j, 1)
  22.                     arr(j, 1) = s
  23.                     End If
  24.             End If
  25.     Next
  26. Next
  27. [a4].Resize(UBound(arr)) = arr
  28. End Sub
複製代碼

TOP

回復 1# ui123

是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, Sp As Variant
  4.     Set Rng = Range("a4")
  5.     Do While Rng <> ""
  6.         Sp = Rng
  7.         For i = 1 To Len(Rng)
  8.             If Mid(Rng, i, 1) Like "[!A-z]" And Mid(Rng, i, 1) Like "[!0-9]" Then
  9.                 'Mid(Rng, i, 1) 不是文字,數字.
  10.                 Sp = Replace(Sp, Mid(Sp, i, 1), ",")  '+"-"或"/"或"#"  替換為 ","
  11.             End If
  12.         Next
  13.         Sp = Split(Sp, ",")
  14.         With Rng.Cells(1, 2).Resize(1, UBound(Sp) + 1)
  15.             .Value = Sp
  16.             .Value = .Value
  17.         End With
  18.         Set Rng = Rng.Offset(1)
  19.     Loop
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE
我明天去公司試試看 ^^~ 先謝謝囉!

TOP

        靜思自在 : 改變自己是自救,影響別人是救人。
返回列表 上一主題