| |
ShellSortを使った例です
Option Explicit
Sub Main()
Dim vntA As Variant
Dim vntB As Variant
Dim vntC As Variant
Dim vntD As Variant
vntA = 1
vntB = 2
vntC = 3
vntD = 4
MsgBox GetList(vntA, vntB, vntC, vntD)
End Sub
Private Function GetList(ParamArray vntData() As Variant) As String
Dim i As Long
Dim strData As String
Dim vntSort As Variant
vntSort = vntData
ShellSort vntSort
For i = 0 To UBound(vntSort)
If strData <> "" Then
strData = strData & "&"
End If
strData = strData & vntSort(i)
Next i
GetList = strData
End Function
Private Sub ShellSort(vntList As Variant)
Dim i As Long
Dim j As Long
Dim lngGap As Long
Dim vntTmp As Variant
Dim lngTop As Long
Dim lngEnd As Long
lngTop = LBound(vntList)
lngEnd = UBound(vntList)
lngGap = 1
Do While lngGap < (lngEnd - lngTop + 1) \ 3
lngGap = 3 * lngGap + 1
Loop
Do Until lngGap <= 0
For i = lngGap + lngTop To lngEnd
vntTmp = vntList(i)
For j = i To lngGap + lngTop Step -lngGap
If vntList(j - lngGap) >= vntTmp Then
Exit For
End If
vntList(j) = vntList(j - lngGap)
Next j
vntList(j) = vntTmp
Next i
lngGap = lngGap \ 3
Loop
End Sub
|
|
Hirofumi
- 08/11/25(火) 19:55 -
