| |
それなら、こんなかな？
Option Explicit
Sub Main_3()
MsgBox GetList(Worksheets("Sheet1").Cells(3, "C").Resize(3, 3))
End Sub
Public Function GetList(rngData As Range) As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim vntData As Variant
Dim strData As String
Dim vntSort As Variant
With rngData
lngRows = .Rows.Count
lngColumns = .Columns.Count
If lngRows = 1 And lngColumns = 1 Then
ReDim vntData(1 To 1, 1 To 1)
vntData(1, 1) = rngData.Value
Else
vntData = rngData.Value
End If
End With
ReDim vntSort(lngRows * lngColumns - 1)
For i = 1 To lngRows
For j = 1 To lngColumns
vntSort(k) = vntData(i, j)
k = k + 1
Next j
Next i
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/26(水) 22:43 -
