- 帖子
- 230
- 主題
- 75
- 精華
- 2
- 積分
- 337
- 點名
- 0
- 作業系統
- Windows 10
- 軟體版本
- Office 2000, 2019
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 彰化縣
- 註冊時間
- 2013-7-18
- 最後登錄
- 2025-4-17
|
2#
發表於 2017-2-19 19:51
| 只看該作者
- Option Explicit
- Option Base 1
- Option Compare Text
- Public Sub S_一維陣列快速插入穩定排序_01(ByRef 原始一維陣列 As Variant, ByVal 起限 As Long, ByVal 迄限 As Long, ByVal 遞增或遞減 As String)
- On Error Resume Next
-
- If 起限 >= 迄限 Then
- Exit Sub
- End If
-
- '------------------------------------------------------
-
- Dim X As Long
-
- Dim 索引陣列() As Long
-
- '------------------------------------------------------
-
- ReDim 索引陣列(起限 To 迄限) As Long
-
- For X = 起限 To 迄限
- 索引陣列(X) = X
- Next X
-
- '------------------------------------------------------
-
- Select Case 遞增或遞減
- Case "遞增"
- 一維陣列快速插入穩定遞增排序 原始一維陣列, 索引陣列, 起限, 迄限
- Case "遞減"
- 一維陣列快速插入穩定遞減排序 原始一維陣列, 索引陣列, 起限, 迄限
- End Select
-
- '------------------------------------------------------
-
- Dim 複製原始一維陣列 As Variant
-
- 複製原始一維陣列 = 原始一維陣列
-
- For X = 起限 To 迄限
- 原始一維陣列(X) = 複製原始一維陣列(索引陣列(X))
- Next X
- End Sub
- Public Sub S_二維陣列快速插入穩定排序_01(ByRef 原始二維陣列 As Variant, ByVal 排序維度 As Long, ByVal 排序鍵值 As Long, ByVal 起限 As Long, ByVal 迄限 As Long, ByVal 遞增或遞減 As String)
- On Error Resume Next
-
- If 起限 >= 迄限 Then
- Exit Sub
- End If
-
- '------------------------------------------------------
-
- Dim X As Long
- Dim Y As Long
-
- Dim 擷取成一維陣列 As Variant
- Dim 索引陣列() As Long
-
- '------------------------------------------------------
-
- ReDim 擷取成一維陣列(起限 To 迄限) As Variant
- ReDim 索引陣列(起限 To 迄限) As Long
-
- If 排序維度 = 1 Then
- For X = 起限 To 迄限
- 擷取成一維陣列(X) = 原始二維陣列(X, 排序鍵值)
- 索引陣列(X) = X
- Next X
- Else
- For Y = 起限 To 迄限
- 擷取成一維陣列(Y) = 原始二維陣列(排序鍵值, Y)
- 索引陣列(Y) = Y
- Next Y
- End If
-
- '------------------------------------------------------
-
- Select Case 遞增或遞減
- Case "遞增"
- 一維陣列快速插入穩定遞增排序 擷取成一維陣列, 索引陣列, 起限, 迄限
- Case "遞減"
- 一維陣列快速插入穩定遞減排序 擷取成一維陣列, 索引陣列, 起限, 迄限
- End Select
-
- '------------------------------------------------------
-
- Dim 複製原始二維陣列 As Variant
-
- 複製原始二維陣列 = 原始二維陣列
-
- If 排序維度 = 1 Then
- For X = 起限 To 迄限
- For Y = LBound(原始二維陣列, 2) To UBound(原始二維陣列, 2)
- 原始二維陣列(X, Y) = 複製原始二維陣列(索引陣列(X), Y)
- Next Y
- Next X
- Else
- For Y = 起限 To 迄限
- For X = LBound(原始二維陣列, 1) To UBound(原始二維陣列, 1)
- 原始二維陣列(X, Y) = 複製原始二維陣列(X, 索引陣列(Y))
- Next X
- Next Y
- End If
- End Sub
複製代碼 |
|