- 帖子
- 230
- 主題
- 75
- 精華
- 2
- 積分
- 337
- 點名
- 0
- 作業系統
- Windows 10
- 軟體版本
- Office 2000, 2019
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 彰化縣
- 註冊時間
- 2013-7-18
- 最後登錄
- 2025-4-17
|
13#
發表於 2017-2-17 00:44
| 只看該作者
最後優化,從原本的0.198秒→0.089秒- Option Explicit
- Option Base 1
- Option Compare Text
- Public Sub S_二維陣列快速插入穩定遞增排序_01(ByRef 原始二維陣列 As Variant, ByVal 排序維度 As Long, ByVal 排序鍵值 As Long, ByVal 起限 As Long, ByVal 迄限 As Long)
- 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
-
- '------------------------------------------------------
-
- 二維陣列快速插入穩定遞增排序 擷取成一維陣列, 索引陣列, 起限, 迄限
-
- '------------------------------------------------------
-
- 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
- Public Sub 二維陣列快速插入穩定遞增排序(ByRef 原始一維陣列 As Variant, ByRef 索引陣列() As Long, ByVal 起限 As Long, ByVal 迄限 As Long)
- On Error Resume Next
-
- If 起限 >= 迄限 Then
- Exit Sub
- End If
-
- '------------------------------------------------------
-
- Dim X As Long
- Dim Y As Long
- Dim S As Long
- Dim M As Long
- Dim E As Long
- Dim N As Long
-
- Dim 暫存 As Variant
- Dim 索引暫存 As Long
- Dim 基準 As Variant
-
- '------------------------------------------------------
-
- If 迄限 - 起限 < 16 Then
- For X = 起限 + 1 To 迄限
- 暫存 = 原始一維陣列(X)
- 索引暫存 = 索引陣列(X)
-
- For Y = X - 1 To 起限 Step -1
- If 暫存 >= 原始一維陣列(Y) Then
- Exit For
- End If
-
- 原始一維陣列(Y + 1) = 原始一維陣列(Y)
- 索引陣列(Y + 1) = 索引陣列(Y)
- Next Y
-
- 原始一維陣列(Y + 1) = 暫存
- 索引陣列(Y + 1) = 索引暫存
- Next X
- Else
- Dim 基準陣列(3) As Variant
-
- 基準陣列(1) = 原始一維陣列(起限)
- 基準陣列(2) = 原始一維陣列((起限 + 迄限) \ 2)
- 基準陣列(3) = 原始一維陣列(迄限)
-
- For X = 2 To 3
- 暫存 = 基準陣列(X)
-
- For Y = X - 1 To 1 Step -1
- If 暫存 >= 基準陣列(Y) Then
- Exit For
- End If
-
- 基準陣列(Y + 1) = 基準陣列(Y)
- Next Y
-
- 基準陣列(Y + 1) = 暫存
- Next X
-
- 基準 = 基準陣列(2)
-
- '------------------------------------------------------
-
- Dim 起陣列 As Variant
- Dim 基陣列 As Variant
- Dim 迄陣列 As Variant
- Dim 索引起陣列() As Long
- Dim 索引基陣列() As Long
- Dim 索引迄陣列() As Long
-
- ReDim 起陣列(迄限 - 起限) As Variant
- ReDim 基陣列(迄限 - 起限 + 1) As Variant
- ReDim 迄陣列(迄限 - 起限) As Variant
- ReDim 索引起陣列(迄限 - 起限) As Long
- ReDim 索引基陣列(迄限 - 起限 + 1) As Long
- ReDim 索引迄陣列(迄限 - 起限) As Long
-
- S = 0
- M = 0
- E = 0
- For X = 起限 To 迄限
- 暫存 = 原始一維陣列(X)
- 索引暫存 = 索引陣列(X)
-
- If 暫存 < 基準 Then
- S = S + 1
- 起陣列(S) = 暫存
- 索引起陣列(S) = 索引暫存
- ElseIf 暫存 = 基準 Then
- M = M + 1
- 基陣列(M) = 暫存
- 索引基陣列(M) = 索引暫存
- Else
- E = E + 1
- 迄陣列(E) = 暫存
- 索引迄陣列(E) = 索引暫存
- End If
- Next X
-
- '------------------------------------------------------
-
- If S > 1 Then
- 二維陣列快速插入穩定遞增排序 起陣列, 索引起陣列, 1, S
- End If
-
- If E > 1 Then
- 二維陣列快速插入穩定遞增排序 迄陣列, 索引迄陣列, 1, E
- End If
-
- '------------------------------------------------------
-
- N = 起限 - 1
- For X = 1 To S
- N = N + 1
- 原始一維陣列(N) = 起陣列(X)
- 索引陣列(N) = 索引起陣列(X)
- Next X
-
- For X = 1 To M
- N = N + 1
- 原始一維陣列(N) = 基陣列(X)
- 索引陣列(N) = 索引基陣列(X)
- Next X
-
- For X = 1 To E
- N = N + 1
- 原始一維陣列(N) = 迄陣列(X)
- 索引陣列(N) = 索引迄陣列(X)
- Next X
- End If
- End Sub
複製代碼 |
|