返回列表 上一主題 發帖

[發問] VBA 字數排序

[發問] VBA 字數排序

請問VBA有辦法依中文字數多寡做排序嗎?
要怎麼寫呢?

回復 2# s13030029

          上傳一個工作表舉個例 應該會比較容易理解

TOP

回復 1# s13030029
  1. Public Sub MergeSort(array_in, begin, final, Optional array_temp)
  2.     'array_in: 1 dimension array
  3.     If begin >= final Then Exit Sub
  4.     If IsMissing(array_temp) Then
  5.         ReDim array_temp(LBound(array_in) To UBound(array_in))
  6.     End If
  7.     Dim mid
  8.     mid = (begin + final) \ 2
  9.     MergeSort array_in, begin, mid, array_temp
  10.     MergeSort array_in, mid + 1, final, array_temp
  11.     Merge array_in, begin, mid, final, array_temp
  12. End Sub

  13. Private Sub Merge(ar, begin, mid, final, temp)
  14.     Dim left: left = begin
  15.     Dim right: right = mid + 1
  16.     Dim i: i = begin
  17.     Do
  18.         If left > mid Then Exit Do
  19.         If right > final Then Exit Do
  20.         If CmprOperator(ar(left), ar(right)) Then
  21.             temp(i) = ar(left)
  22.             left = left + 1
  23.         Else
  24.             temp(i) = ar(right)
  25.             right = right + 1
  26.         End If
  27.         i = i + 1
  28.     Loop
  29.     For n = left To mid
  30.         temp(i) = ar(n)
  31.         i = i + 1
  32.     Next
  33.     For n = right To final
  34.         temp(i) = ar(n)
  35.         i = i + 1
  36.     Next
  37.     For n = begin To final
  38.         ar(n) = temp(n)
  39.     Next
  40. End Sub
  41. Private Function CmprOperator(a, b) As Boolean
  42.     If Len(a) <= Len(b) Then
  43.         CmprOperator = True
  44.     Else
  45.         CmprOperator = False
  46.     End If
  47. End Function
複製代碼
  1. Public Sub test()
  2.     Dim ar
  3.     ar = Array("請問", "VBA", "有辦法", "依", "中文字數多寡", "做", "排序", "嗎")
  4.     MergeSort ar, LBound(ar), UBound(ar)
  5.     Debug.Print Join(ar, ",")
  6.     ' Output>> 依,做,嗎,請問,排序,VBA,有辦法,中文字數多寡
  7. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 3# Scott090
回復 4# stillfish00
依照C欄儀器做排序
test.rar (11.32 KB)

TOP

回復 4# s13030029


    test20190528.rar (13.45 KB)
    請測試是不是你要的

TOP

回復 5# Scott090
謝謝~這是我要的~

TOP

        靜思自在 : 慈悲沒有敵人,智慧不起煩惱。
返回列表 上一主題