2019年7月9日 – VBA SQL

テーブルに入れると言う手もあります
これが一番簡単
SQLserverとつながっているなら一時テーブルに入れ込む

Public Function TableSort(Ary As Variant) As Variant
'Dim Ary
'Ary = Array("5", "4", "1", "2", "900", "888")

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.ConnectionString = "接続文字列"
cn.Open

Dim I As Long
I = 0
cn.Execute "drop table if exists #AryT"
cn.Execute "select " & CLng(Ary(I)) & "as C into #AryT"

For I = 1 To UBound(Ary)
    cn.Execute "insert into #AryT(C) values(" & CLng(Ary(I)) & ")"
Next I

rs.Open "select C from #AryT order by C asc", cn, adOpenStatic, adLockOptimistic

rs.MoveFirst

I = 0
Do Until rs.EOF
    Ary(I) = rs!C
    rs.MoveNext
    I = I + 1
Loop

'For I = 0 To UBound(Ary)
'    Debug.Print Ary(I)
'Next

TableSort = Ary

 rs.Close
 cn.Close

End Function

Public Function TableSort(Ary As Variant) As Variant

'Dim Ary

'Ary = Array("5", "4", "1", "2", "900", "888")

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset

Set cn = New ADODB.Connection

Set rs = New ADODB.Recordset

cn.ConnectionString = "接続文字列"

cn.Open

Dim I As Long

I = 0

cn.Execute "drop table if exists #AryT"

cn.Execute "select " & CLng(Ary(I)) & "as C into #AryT"

For I = 1 To UBound(Ary)

cn.Execute "insert into #AryT(C) values(" & CLng(Ary(I)) & ")"

Next I

rs.Open "select C from #AryT order by C asc", cn, adOpenStatic, adLockOptimistic

rs.MoveFirst

I = 0

Do Until rs.EOF

Ary(I) = rs!C

rs.MoveNext

I = I + 1

Loop

'For I = 0 To UBound(Ary)

' Debug.Print Ary(I)

'Next

TableSort = Ary

rs.Close

cn.Close

End Function

バブルソートは時間がかかる
quick sortはササッと書くのは難しい
ので選択ソート

Public Function SelectSort(Ary As Variant) As Variant

'Dim Ary
'Ary = Array("0", "1", "1", "2", "900", "888")

Dim I As Long, j As Long
Dim Min As Long, flag As Long
Dim newA As String, newB As String, Mark As Long

For I = 0 To UBound(Ary) - 1
    flag = CLng(Ary(I))
    Min = CLng(Ary(I))
    Mark = I
    
    For j = 1 To UBound(Ary) - I
        If Min > CLng(Ary(I + j)) Then
            Min = CLng(Ary(I + j))
            Mark = I + j
        End If
    Next j
    
    newA = CStr(Min)
    newB = CStr(flag)
    
If Not Mark = I Then
    Ary(I) = newA
    Ary(Mark) = newB
End If
Next I

'For I = 0 To UBound(Ary)
'    Debug.Print Ary(I)
'Next

SelectSort = Ary
 
End Function

Public Function SelectSort(Ary As Variant) As Variant

'Dim Ary

'Ary = Array("0", "1", "1", "2", "900", "888")

Dim I As Long, j As Long

Dim Min As Long, flag As Long

Dim newA As String, newB As String, Mark As Long

For I = 0 To UBound(Ary) - 1

flag = CLng(Ary(I))

Min = CLng(Ary(I))

Mark = I

For j = 1 To UBound(Ary) - I

If Min > CLng(Ary(I + j)) Then

Min = CLng(Ary(I + j))

Mark = I + j

End If

Next j

newA = CStr(Min)

newB = CStr(flag)

If Not Mark = I Then

Ary(I) = newA

Ary(Mark) = newB

End If

Next I

'For I = 0 To UBound(Ary)

' Debug.Print Ary(I)

'Next

SelectSort = Ary

End Function

こんな感じで

月	火	水	木	金	土	日
« 6月				8月 »
1	2	3	4	5	6	7
8	9	10	11	12	13	14
15	16	17	18	19	20	21
22	23	24	25	26	27	28
29	30	31

日: 2019年7月9日

VBAで配列をソート　テーブルを使う

VBAで配列をソート　選択ソート