配列操作用ＣＯＭ
vb/vbs配列操作用のＣＯＭを作ってみました。 H24/3/27更新
簡単にいうとデータベースやExcel不要でソートが行えます。
※Excelは扱えるデータ件数に限界があります
三次元までのREDIM（再定義）と各種ソート（並べ替え）、GetDim（次元数取得）。
サンプルを見れば誰でも簡単に使えると思います。
REDIM（再定義）は通常は無理な左側の１・２次元目の数も増やせます。
SORT（並べ替え）は元の配列を変更しない仮想ソート（結果のインデックスだけ返す）と
実際に元の配列の並べ替えを実行するメソッドの両方があります。
すべてstd::stable_sortを使用、縦横ソートメソッド全１２個。
複数条件対応の２個はSQL文の”ORDER BY 列1 ASC, 列2 DESC ．．．”相当。
標準ライブラリー使用なのでVB内でソートするよりはたぶん早いと思います。
次元数取得はVB系に実現コードはあるけど機能が無いのでつけました。
他はヘルパー用に次元や項目の入れ換え、UUID生成メソッド。
実用件数はセレロンCPU機で数万～数十万件、またはメモリと時間の限界まで。
動作環境はx86CPU(32/64)のWin98～Win8まですべて。
以下はＳＯＲＴの使用方法のサンプルＶＢＳです。メソッド発行は１行で済みますがテスト用データセットが長いです・・・
''説明文・・・仕様、メソッド・・・長いのでここでは省略
Option Explicit
Dim MyObject, Ret, ColumnIndex, RowIndex
Dim MyDim1, MyDim2, MyDim3, MyDim4(4,3), MyDim5(3,2,4), MyDim6(10,10,0)
Dim MyDimX()
Set MyObject = WScript.CreateObject("Variant.SafeArray")
'' １次元ソート
MyDim1 = Array(33, 99, 111, 11, 66)
WScript.Echo "Sort1(1) : " & MyObject.cSort1(MyDim1)
WScript.Echo "並べ替えの結果、以下の順になります"
SortResultOut1 MyDim1
WScript.Echo
MyDim2 = Array("AaAaA", "AAAAA", "aaAAA", "aaaaa", "AaaaA", "aAAAa", "AAaaa")
WScript.Echo "Sort1(2) : " & MyObject.cSort1(MyDim2)
WScript.Echo "並べ替えの結果、以下の順になります"
SortResultOut1 MyDim2
WScript.Echo
MyDim3 = Array("AbAbA", "AAAAA", "bbAAA", "bbbbb", "AbbbA", "bAAAb", "AAbbb")
WScript.Echo "Sort1(3) : " & MyObject.cSort1(MyDim3, "1")
WScript.Echo "並べ替えの結果、以下の順になります"
SortResultOut1 MyDim3
WScript.Echo
'' ２次元ソート
MyDim4(0,0) = "名字Ａ名前Ａ"
MyDim4(0,1) = "〒376-0021"
MyDim4(0,2) = CCur("\300000.45")
MyDim4(0,3) = CDate("1989/10/28 10:30")
MyDim4(1,0) = "名字B名前b"
MyDim4(1,1) = "〒020-1000"
MyDim4(1,2) = CCur("\223000.0")
MyDim4(1,3) = CDate("1953/2/11 15:30")
MyDim4(2,0) = "名字Ｃ名前Ｃ"
MyDim4(2,1) = "〒105-1201"
MyDim4(2,2) = CCur("\520000.8")
MyDim4(2,3) = CDate("2002/4/7 4:30")
MyDim4(3,0) = "名字A名前Ａ"
MyDim4(3,1) = "〒510-2641"
MyDim4(3,2) = CCur("\170000.2")
MyDim4(3,3) = CDate("1999/5/19 8:30")
MyDim4(4,0) = "名字Ａ名前B"
MyDim4(4,1) = "〒188-0030"
MyDim4(4,2) = CCur("\840000.99")
MyDim4(4,3) = CDate("1920/7/22 12:30")
ColumnIndex = 3
WScript.Echo "Sort2(4) : " & MyObject.cSort2(MyDim4, ColumnIndex)
WScript.Echo "カラム" & ColumnIndex & "番目での並べ替えの結果、以下の順になります"
SortResultOut2 MyDim4
WScript.Echo
ColumnIndex = 1
WScript.Echo "Sort2(5) : " & MyObject.cSort2(MyDim4, ColumnIndex, "11111")
WScript.Echo "カラム" & ColumnIndex & "番目での並べ替えの結果、以下の順になります"
SortResultOut2 MyDim4
WScript.Echo
''２次元配列の行列入れ換え：元の配列がカラム(列)でのソートに適さない場合
''カラムが人名で行が付帯情報の場合
ReDim MyDimX(4,3)
MyDimX(0,0) = "氏名ＺＺＺ"
MyDimX(0,1) = "氏名ＦＦＦ"
MyDimX(0,2) = "氏名ＢＢＢ"
MyDimX(0,3) = "氏名ＰＰＰ"
MyDimX(1,0) = "1990/02/02 02:02:02"
MyDimX(1,1) = "1990/01/01 01:01:01"
MyDimX(1,2) = "1990/12/12 12:12:12"
MyDimX(1,3) = "1990/03/03 03:03:03"
MyDimX(2,0) = "〒888-8888"
MyDimX(2,1) = "〒999-9999"
MyDimX(2,2) = "〒111-1111"
MyDimX(2,3) = "〒222-2222"
MyDimX(3,0) = "点２２２"
MyDimX(3,1) = "点１１１"
MyDimX(3,2) = "点９９９"
MyDimX(3,3) = "点３３３"
MyDimX(4,0) = "戦闘力0,030,000" ''項目が文字型なのでソート用に桁を揃えている
MyDimX(4,1) = "戦闘力0,200,000"
MyDimX(4,2) = "戦闘力0,000,666"
MyDimX(4,3) = "戦闘力0,000,010"
WScript.Echo "Change2(1) : " & MyObject.Change2(MyDimX)
ColumnIndex = 4 ''入れ換え後のカラム番号になっているので注意（戦闘力）
WScript.Echo "Sort2(9) : " & MyObject.cSort2(MyDimX, ColumnIndex)
WScript.Echo "行列を入れ換えてソートした結果"
SortResultOut2 MyDimX
''元の行列表現にしたい場合は以下のコメントを外し再度入れ換える
''WScript.Echo "Change2(2) : " & MyObject.Change2(MyDimX)
''WScript.Echo "一旦行列を入れ換えてソートして行列を再入れ換えで戻した結果"
''SortResultOut2 MyDimX
WScript.Echo
'' ３次元ソート
MyDim5(0,0,0) = 31
MyDim5(0,1,0) = 32
MyDim5(0,2,0) = CLng(76543)
MyDim5(1,0,0) = 34
MyDim5(1,1,0) = 35
MyDim5(1,2,0) = 36
MyDim5(2,0,0) = 37
MyDim5(2,1,0) = 38
MyDim5(2,2,0) = 39
MyDim5(3,0,0) = 311
MyDim5(3,1,0) = 321
MyDim5(3,2,0) = 333
MyDim5(0,0,1) = 11
MyDim5(0,1,1) = 12
MyDim5(0,2,1) = CLng(98765)
MyDim5(1,0,1) = 14
MyDim5(1,1,1) = 15
MyDim5(1,2,1) = 16
MyDim5(2,0,1) = 17
MyDim5(2,1,1) = 18
MyDim5(2,2,1) = 19
MyDim5(3,0,1) = 111
MyDim5(3,1,1) = 121
MyDim5(3,2,1) = 133
MyDim5(0,0,2) = 81
MyDim5(0,1,2) = 82
MyDim5(0,2,2) = CLng(23456)
MyDim5(1,0,2) = 84
MyDim5(1,1,2) = 85
MyDim5(1,2,2) = 86
MyDim5(2,0,2) = 87
MyDim5(2,1,2) = 88
MyDim5(2,2,2) = 89
MyDim5(3,0,2) = 811
MyDim5(3,1,2) = 821
MyDim5(3,2,2) = 833
MyDim5(0,0,3) = 51
MyDim5(0,1,3) = 52
MyDim5(0,2,3) = CLng(34567)
MyDim5(1,0,3) = 54
MyDim5(1,1,3) = 55
MyDim5(1,2,3) = 56
MyDim5(2,0,3) = 57
MyDim5(2,1,3) = 58
MyDim5(2,2,3) = 59
MyDim5(3,0,3) = 511
MyDim5(3,1,3) = 521
MyDim5(3,2,3) = 533
MyDim5(0,0,4) = 61
MyDim5(0,1,4) = 62
MyDim5(0,2,4) = CLng(12345)
MyDim5(1,0,4) = 64
MyDim5(1,1,4) = 65
MyDim5(1,2,4) = 66
MyDim5(2,0,4) = 67
MyDim5(2,1,4) = 68
MyDim5(2,2,4) = 69
MyDim5(3,0,4) = 611
MyDim5(3,1,4) = 621
MyDim5(3,2,4) = 633
RowIndex = 0
ColumnIndex = 2
WScript.Echo "Sort3(6) : " & MyObject.cSort3(MyDim5, RowIndex, ColumnIndex)
WScript.Echo "行列" & RowIndex & ":" & ColumnIndex & "位置での並べ替えの結果、以下の順になります"
SortResultOut3 MyDim5
WScript.Echo
RowIndex = 0
ColumnIndex = 0
WScript.Echo "Sort3(7) : " & MyObject.cSort3(MyDim6, RowIndex, ColumnIndex)
WScript.Echo "行列" & RowIndex & ":" & ColumnIndex & "位置での並べ替えの結果、以下の順になります"
SortResultOut3 MyDim6
WScript.Echo
If 0 <> Err.Number Then
WScript.Echo "VBScript Error: " & Err.Source & "/" & Err.Number & "/" & Err.Description
End If
WScript.Quit(Err.Number)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' 内容表示
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub SortResultOut1(OrgArray)
If False = IsArray(OrgArray) Then
WScript.Echo "Exit Sub": Exit Sub
End If
Dim idx1
For idx1 = LBound(OrgArray, 1) To UBound(OrgArray, 1)
WScript.Echo "順位" & idx1 & " " & OrgArray(idx1)
Next
End Sub
Sub SortResultOut2(OrgArray)
If False = IsArray(OrgArray) Then
WScript.Echo "Exit Sub": Exit Sub
End If
Dim idx1, idx2, Val
For idx1 = LBound(OrgArray, 1) To UBound(OrgArray, 1)
WScript.Echo "------------------------- 順位" & idx1
For idx2 = LBound(OrgArray, 2) To UBound(OrgArray, 2)
Val = OrgArray(idx1, idx2)
If vbDate = VarType(Val) Then
WScript.Echo FormatDateTime(Val,vbLongDate) & " " & FormatDateTime(Val,vbShortTime)
ElseIf vbCurrency = VarType(Val) Then
WScript.Echo FormatCurrency(Val)
Else
WScript.Echo Val
End If
Next
Next
End Sub
Sub SortResultOut3(OrgArray)
If False = IsArray(OrgArray) Then
WScript.Echo "Exit Sub": Exit Sub
End If
''テストデータが三次元目を区切りにした頁概念なのでidx3から回して表現してます
Dim idx1, idx2, idx3, Val
For idx3 = LBound(OrgArray, 3) To UBound(OrgArray, 3)
WScript.Echo "------------------------- 順位" & idx3
For idx1 = LBound(OrgArray, 1) To UBound(OrgArray, 1)
Val = ""
For idx2 = LBound(OrgArray, 2) To UBound(OrgArray, 2)
''最後のテスト"Sort3(7)"は配列の中身が無いのでスキップ判定
If False = IsEmpty(OrgArray(idx1, idx2, idx3)) Then
Val = Val & OrgArray(idx1, idx2, idx3) & "," & vbTab
End If
Next
If 0 < Len(Val) Then
WScript.Echo Val
End If
Next
Next
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''' 実行結果 ''''''''''''''''''''''''''''''''''''''''
Sort1(1) : 0
並べ替えの結果、以下の順になります
順位0 11
順位1 33
順位2 66
順位3 99
順位4 111
Sort1(2) : 0
並べ替えの結果、以下の順になります
順位0 aaaaa
順位1 aaAAA
順位2 aAAAa
順位3 AaaaA
順位4 AaAaA
順位5 AAaaa
順位6 AAAAA
Sort1(3) : 0
並べ替えの結果、以下の順になります
順位0 AAAAA
順位1 AAbbb
順位2 AbAbA
順位3 AbbbA
順位4 bAAAb
順位5 bbAAA
順位6 bbbbb
Sort2(4) : 0
カラム3番目での並べ替えの結果、以下の順になります
------------------------- 順位0
名字Ａ名前B
〒188-0030
\840,001
大正 9年7月22日 木曜日 12:30
------------------------- 順位1
名字B名前b
〒020-1000
\223,000
昭和 28年2月11日 水曜日 15:30
------------------------- 順位2
名字Ａ名前Ａ
〒376-0021
\300,000
平成 1年10月28日 土曜日 10:30
------------------------- 順位3
名字A名前Ａ
〒510-2641
\170,000
平成 11年5月19日 水曜日 08:30
------------------------- 順位4
名字Ｃ名前Ｃ
〒105-1201
\520,001
平成 14年4月7日 日曜日 04:30
Sort2(5) : 0
カラム1番目での並べ替えの結果、以下の順になります
------------------------- 順位0
名字B名前b
〒020-1000
\223,000
昭和 28年2月11日 水曜日 15:30
------------------------- 順位1
名字Ｃ名前Ｃ
〒105-1201
\520,001
平成 14年4月7日 日曜日 04:30
------------------------- 順位2
名字Ａ名前B
〒188-0030
\840,001
大正 9年7月22日 木曜日 12:30
------------------------- 順位3
名字Ａ名前Ａ
〒376-0021
\300,000
平成 1年10月28日 土曜日 10:30
------------------------- 順位4
名字A名前Ａ
〒510-2641
\170,000
平成 11年5月19日 水曜日 08:30
Change2(1) : 0
Sort2(9) : 0
行列を入れ換えてソートした結果
------------------------- 順位0
氏名ＰＰＰ
1990/03/03 03:03:03
〒222-2222
点３３３
戦闘力0,000,010
------------------------- 順位1
氏名ＢＢＢ
1990/12/12 12:12:12
〒111-1111
点９９９
戦闘力0,000,666
------------------------- 順位2
氏名ＺＺＺ
1990/02/02 02:02:02
〒888-8888
点２２２
戦闘力0,030,000
------------------------- 順位3
氏名ＦＦＦ
1990/01/01 01:01:01
〒999-9999
点１１１
戦闘力0,200,000
Sort3(6) : 0
行列0:2位置での並べ替えの結果、以下の順になります
------------------------- 順位0
61, 62, 12345,
64, 65, 66,
67, 68, 69,
611, 621, 633,
------------------------- 順位1
81, 82, 23456,
84, 85, 86,
87, 88, 89,
811, 821, 833,
------------------------- 順位2
51, 52, 34567,
54, 55, 56,
57, 58, 59,
511, 521, 533,
------------------------- 順位3
31, 32, 76543,
34, 35, 36,
37, 38, 39,
311, 321, 333,
------------------------- 順位4
11, 12, 98765,
14, 15, 16,
17, 18, 19,
111, 121, 133,
Sort3(7) : 0
行列0:0位置での並べ替えの結果、以下の順になります
------------------------- 順位0
＠ぐるぐるのスペース 
コメントする
0件のコメント