|
だとすると、こんなかな?
Option Explicit
Type SampleData
a(8) As Long
End Type
Public Sub Sample()
Dim i As Long
Dim usrData As SampleData
With usrData
For i = 0 To 8
.a(i) = Choose(i + 1, 5, 4, 7, 6, 9, 2, 3, 1, 8)
Next i
End With
ShellSort usrData
With usrData
For i = 0 To 8
Debug.Print .a(i)
Next i
End With
End Sub
Public Sub ShellSort(usrList As SampleData, _
Optional lngNum As Long = -1, _
Optional lngStart As Long = -1)
' シェルソート
Dim i As Long
Dim j As Long
Dim lngGap As Long
Dim lngTmp As Variant
Dim lngTop As Long
Dim lngEnd As Long
With usrList
lngTop = LBound(.a, 1)
If lngStart > -1 Then
If lngStart >= LBound(.a, 1) Then
lngTop = lngStart
End If
End If
lngEnd = UBound(.a, 1)
If lngNum > -1 Then
If lngTop + lngNum - 1 <= UBound(.a, 1) Then
lngEnd = lngTop + lngNum - 1
End If
End If
lngGap = 1
Do While lngGap < (lngEnd - lngTop + 1) \ 3
lngGap = 3 * lngGap + 1
Loop
Do Until lngGap <= 0
For i = lngGap + lngTop To lngEnd
lngTmp = .a(i)
For j = i To lngGap + lngTop Step -lngGap
If .a(j - lngGap) <= lngTmp Then
Exit For
End If
.a(j) = .a(j - lngGap)
Next j
.a(j) = lngTmp
Next i
lngGap = lngGap \ 3
Loop
End With
End Sub
|
|