Board logo

標題: [發問] VBA 字數排序 [打印本頁]
作者: s13030029    時間: 2019-5-22 10:46     標題: VBA 字數排序

請問VBA有辦法依中文字數多寡做排序嗎?
要怎麼寫呢?
作者: Scott090    時間: 2019-5-23 20:08

回復 2# s13030029

          上傳一個工作表舉個例 應該會比較容易理解
作者: stillfish00    時間: 2019-5-24 14:42

回復 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

  14. Private Sub Merge(ar, begin, mid, final, temp)
  15.     Dim left: left = begin
  16.     Dim right: right = mid + 1
  17.     Dim i: i = begin
  18.     Do
  19.         If left > mid Then Exit Do
  20.         If right > final Then Exit Do
  21.         If CmprOperator(ar(left), ar(right)) Then
  22.             temp(i) = ar(left)
  23.             left = left + 1
  24.         Else
  25.             temp(i) = ar(right)
  26.             right = right + 1
  27.         End If
  28.         i = i + 1
  29.     Loop
  30.     For n = left To mid
  31.         temp(i) = ar(n)
  32.         i = i + 1
  33.     Next
  34.     For n = right To final
  35.         temp(i) = ar(n)
  36.         i = i + 1
  37.     Next
  38.     For n = begin To final
  39.         ar(n) = temp(n)
  40.     Next
  41. End Sub
  42. Private Function CmprOperator(a, b) As Boolean
  43.     If Len(a) <= Len(b) Then
  44.         CmprOperator = True
  45.     Else
  46.         CmprOperator = False
  47.     End If
  48. 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
複製代碼
作者: s13030029    時間: 2019-5-28 13:53

回復 3# Scott090
回復 4# stillfish00
依照C欄儀器做排序
[attach]30697[/attach]
作者: Scott090    時間: 2019-5-28 15:57

回復 4# s13030029


    [attach]30701[/attach]
    請測試是不是你要的
作者: s13030029    時間: 2019-5-28 16:04

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



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