このバブル ソート アルゴリズムが VBA を使用していることに驚きました。だから私の質問は、私が間違っている/非効率的なことをしているのですか、それともこれがVBAとバブルソートが行う最善の方法ですか? たとえば、VARIANT を使用したり、変数が多すぎたりすると、パフォーマンスが大幅に低下する可能性があります。バブルソートがそれほど速くないことは知っていますが、これほど遅いとは思いませんでした。
アルゴリズム入力: 2D 配列と、昇順または降順でソートする 1 つまたは 2 つの列。必ずしも電光石火の速さは必要ありませんが、5,000 行で 30 秒というのはまったく受け入れられません
Option Explicit
Sub sortA()
Dim start_time, end_time
start_time = Now()
Dim ThisArray() As Variant
Dim sheet As Worksheet
Dim a, b As Integer
Dim rows, cols As Integer
Set sheet = ArraySheet
rows = 5000
cols = 3
ReDim ThisArray(0 To cols - 1, 0 To rows - 1)
For a = 1 To rows
For b = 1 To cols
ThisArray(b - 1, a - 1) = ArraySheet.Cells(a, b)
Next b
Next a
Call BubbleSort(ThisArray, 0, False, 2, True)
end_time = Now()
MsgBox (DateDiff("s", start_time, end_time))
End Sub
'Array Must Be: Array(Column,Row)
Sub BubbleSort(ThisArray As Variant, SortColumn1 As Integer, Asc1 As Boolean, Optional SortColumn2 As Integer = -1, Optional Asc2 As Boolean)
Dim FirstRow As Integer
Dim LastRow As Integer
Dim FirstCol As Integer
Dim LastCol As Integer
Dim lTemp As Variant
Dim i, j, k As Integer
Dim a1, a2, b1, b2 As Variant
Dim CompareResult As Boolean
FirstRow = LBound(ThisArray, 2)
LastRow = UBound(ThisArray, 2)
FirstCol = LBound(ThisArray, 1)
LastCol = UBound(ThisArray, 1)
For i = FirstRow To LastRow
For j = i + 1 To LastRow
If SortColumn2 = -1 Then 'If there is only one column to sort by
a1 = ThisArray(SortColumn1, i)
a2 = ThisArray(SortColumn1, j)
If Asc1 = True Then
CompareResult = compareOne(a1, a2)
Else
CompareResult = compareOne(a2, a1)
End If
Else 'If there are two columns to sort by
a1 = ThisArray(SortColumn1, i)
a2 = ThisArray(SortColumn1, j)
b1 = ThisArray(SortColumn2, i)
b2 = ThisArray(SortColumn2, j)
If Asc1 = True Then
If Asc2 = True Then
CompareResult = compareTwo(a1, a2, b1, b2)
Else
CompareResult = compareTwo(a1, a2, b2, b1)
End If
Else
If Asc2 = True Then
CompareResult = compareTwo(a2, a1, b1, b2)
Else
CompareResult = compareTwo(a2, a1, b2, b1)
End If
End If
End If
If CompareResult = True Then ' If compare result returns true, Flip rows
For k = FirstCol To LastCol
lTemp = ThisArray(k, j)
ThisArray(k, j) = ThisArray(k, i)
ThisArray(k, i) = lTemp
Next k
End If
Next j
Next i
End Sub
Function compareOne(FirstCompare1 As Variant, FirstCompare2 As Variant) As Boolean
If FirstCompare1 > FirstCompare2 Then
compareOne = True
Else
compareOne = False
End If
End Function
Function compareTwo(FirstCompare1 As Variant, FirstCompare2 As Variant, SecondCompare1 As Variant, SecondCompare2 As Variant) As Boolean
If FirstCompare1 > FirstCompare2 Then
compareTwo = True
ElseIf FirstCompare1 = FirstCompare2 And SecondCompare1 > SecondCompare2 Then
compareTwo = True
Else
compareTwo = False
End If
End Function
助けやアドバイスをありがとう！
編集: 代わりに QuickSort を使用することにしました。興味がある場合は、コードについては以下の投稿を参照してください。