| |
参考出品。配列とクイックソートで試してみました。
Sub sample()
Dim v()
Dim y As Long
Dim i As Long
With Range("A1", Range("A65536").End(xlUp))
v = .Resize(, 2).Value
y = UBound(v)
For i = 1 To y
v(i, 2) = Right$(v(i, 1), 3)
Next i
Call QArysort(v, 1, y, 1, 2, 2)
ReDim Preserve v(1 To y, 1 To 1)
.ClearContents
.Value = v
End With
End Sub
Private Sub QArysort(ByRef Ary() As Variant, _
ByVal Lo As Long, ByVal Up As Long, _
ByVal Li As Long, ByVal Ui As Long, _
ByVal Cn As Long)
Dim tmpary()
Dim ac As Long
Dim i As Long, j As Long
Dim x As Long
If Lo >= Up Then Exit Sub
ac = Ary((Up + Lo) \ 2, Cn)
i = Lo - 1
j = Up + 1
Do
ReDim tmpary(Li To Ui)
Do
i = i + 1
Loop While Ary(i, Cn) < ac
Do
j = j - 1
Loop While Ary(j, Cn) > ac
If i >= j Then Exit Do
For x = Li To Ui
tmpary(x) = Ary(j, x)
Ary(j, x) = Ary(i, x)
Ary(i, x) = tmpary(x)
Next x
Loop
If i - Lo > 1 Then QArysort Ary, Lo, i - 1, Li, Ui, Cn
If Up - j > 1 Then QArysort Ary, j + 1, Up, Li, Ui, Cn
End Sub
#アルゴリズムとかはよくわかってないので見ようみまねです^ ^;
|
|
Ned
- 06/9/16(土) 23:10 -
