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