- 帖子
- 1018
- 主題
- 15
- 精華
- 0
- 積分
- 1058
- 點名
- 0
- 作業系統
- win7 32bit
- 軟體版本
- Office 2016 64-bit
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 桃園
- 註冊時間
- 2012-5-9
- 最後登錄
- 2022-9-28
|
3#
發表於 2019-5-24 14:42
| 只看該作者
回復 1# s13030029 - Public Sub MergeSort(array_in, begin, final, Optional array_temp)
- 'array_in: 1 dimension array
- If begin >= final Then Exit Sub
- If IsMissing(array_temp) Then
- ReDim array_temp(LBound(array_in) To UBound(array_in))
- End If
- Dim mid
- mid = (begin + final) \ 2
- MergeSort array_in, begin, mid, array_temp
- MergeSort array_in, mid + 1, final, array_temp
- Merge array_in, begin, mid, final, array_temp
- End Sub
- Private Sub Merge(ar, begin, mid, final, temp)
- Dim left: left = begin
- Dim right: right = mid + 1
- Dim i: i = begin
- Do
- If left > mid Then Exit Do
- If right > final Then Exit Do
- If CmprOperator(ar(left), ar(right)) Then
- temp(i) = ar(left)
- left = left + 1
- Else
- temp(i) = ar(right)
- right = right + 1
- End If
- i = i + 1
- Loop
- For n = left To mid
- temp(i) = ar(n)
- i = i + 1
- Next
- For n = right To final
- temp(i) = ar(n)
- i = i + 1
- Next
- For n = begin To final
- ar(n) = temp(n)
- Next
- End Sub
- Private Function CmprOperator(a, b) As Boolean
- If Len(a) <= Len(b) Then
- CmprOperator = True
- Else
- CmprOperator = False
- End If
- End Function
- Public Sub test()
- Dim ar
- ar = Array("請問", "VBA", "有辦法", "依", "中文字數多寡", "做", "排序", "嗎")
- MergeSort ar, LBound(ar), UBound(ar)
- Debug.Print Join(ar, ",")
- ' Output>> 依,做,嗎,請問,排序,VBA,有辦法,中文字數多寡
- End Sub
|
|
