VBA 桁数が混在するソート

シートやセルを使わず、VBAのみでクイックソートを実装したいのですが
桁数が混在する列だと正しくソートされません。
1
1
10
10
15
2
等と言う結果になります。

元のデータは外部ファイルで修正をかけたくないので
VBA内で格納したデータの桁数を調節する等解決策はありますでしょうか？


以下メソッドです

Sub QuickSort1(ByRef argAry As Variant, ByVal lngMin As Long, ByVal lngMax As Long, sortnum As Integer)
Dim i As Long
Dim j As Long
Dim vBase As Variant
Dim vSwap() As Variant: ReDim vSwap(UBound(argAry))
vBase = argAry(sortnum)(Int((lngMin + lngMax) / 2))
i = lngMin
j = lngMax
Do
Do While argAry(sortnum)(i) < vBase
i = i + 1
Loop
Do While argAry(sortnum)(j) > vBase
j = j - 1
Loop
If i >= j Then Exit Do
For i3 = 1 To UBound(argAry)
vSwap(i3) = argAry(i3)(i)
argAry(i3)(i) = argAry(i3)(j)
argAry(i3)(j) = vSwap(i3)
Next
i = i + 1
j = j - 1
Loop
If (lngMin < i - 1) Then
Call QuickSort1(argAry, lngMin, i - 1, sortnum)
End If
If (lngMax > j + 1) Then
Call QuickSort1(argAry, j + 1, lngMax, sortnum)
End If


End Sub

No.6 回答者： WindFaller 回答日時： 2014/07/05 10:22

補足です。

質問の内容とは離れてはいますが、例えば、1次元なら、このようなこともできます。
アルゴリズムなどは入りません。

'//
Sub Test1a()
　'並べ替え1 (文字列は入れられない)
　Dim Ar1
　Dim Ar2
　Dim i As Long
　Ar1 = Array(1, 1, 10, 10, 15, 0, 3, 6, 8, 9)
　Ar2 = Ar1
　For i = 1 To UBound(Ar1) + 1
　　Ar2(i - 1) = Application.Small(Ar1, i)
　Next i
　Stop
End Sub

Sub Test2a()
　'並べ替え2 '.Net Framework を利用する。Excel 2003以上なら可能
　Dim AL As Object
　Dim Ar1
　Dim v As Variant
　Set AL = CreateObject("System.Collections.ArrayList")
　Ar1 = Array("1", "1.0a", "10", "10", "15", "0", "3", "6", "8", "9")
　For Each v In Ar1　'文字列排除
　　If IsNumeric(v) Then
　　　AL.Add CDbl(v)
　　End If
　Next v
　AL.Sort
　Ar1 = AL.ToArray
　Set AL = Nothing
　Stop
End Sub

'//
p.s.
#5の
>アルゴリズムのテキストを参照はしていないけれども、
自分のコードに対しては、テキストで確認しました。

No.5 回答者： WindFaller 回答日時： 2014/07/03 20:51

#3の回答者です。

他の方の回答を読んでいて、気がついたけれども、#3で書いたように、やっぱりMain側をみないといけないかもしれませんね。

つまり、引数のargAry の元の配列が、そのようなジャグ配列になる原因は、何からかは知りませんが、数値なのか、文字列なのかは、考えていませんでした。ただ、私は、こちらで試してVBE上でエラーが出るものに対して直しただけであって、配列の中身は、数値でなければ、ソートは、文字列の順になりますね。混在していれば、文字列は、いかなる数値より大きいわけですから、下に行きます。これは、表計算上のソートと同じ仕様です。

QuickSort は、文字列か数値かを区分けするわけではなく、文字と数値の比較でも行えます。
これは、どの言語でも同じです。言い換えれば、QuickSort の問題ではないはずです。
文字列の比較なら、質問通りになるわけです。当たり前ですね。

あえて、今は、アルゴリズムのテキストを参照はしていないけれども、QuickSort自体は、規定のアルゴリズムですから、それをいじるというのは、よほどのことがない限りは、私個人としては、アルゴリズムを弄りたくありません。

当然、数値と文字の混在なら、それなりのソートが出来上がるわけですが、「IsNumericを利用して」って、IsNumericは、別の文字列も数値も関係なく、「見かけ上の数字」だけなのですから、分別はできません。だから、数値に変える必要があります。ただ、文字列の排除をするとかなら、QuickSort 自体も、1次元で処理するように作ったほうがよいと思いますね。排除する時にループするのですから。

それと、サブルーチン側に、配列のすべてを与える必要はもともとないと思います。
メモリ保持が大きくなりすぎます。

後出しで、実はとされるよりも、そろそろ、元データとそれを与える部分（Sub Main())を明かしていただいたほうが、より良いと思います。

'こんな内容になってしまいましたが、そのままの状態から、やむを得ない回答です。

Sub Main()
　Dim ar(0) As Variant
　Dim ar1() As Variant
　Dim i As Long
　Dim j As Long
　
　Dim l As Long
　Dim u As Long
　
　ar(0) = Array("1", "1", "10", "10", "15", "0", "3", "6", "8", "9a", "0")
　For i = LBound(ar(0)) To UBound(ar(0))
　　If IsNumeric(ar(0)(i)) Then　'純文字列を排除
　　　ReDim Preserve ar1(j)
　　　ar1(j) = CDbl(ar(0)(i))　'一応、Double型にしたけれども、整数なら、CLngで可能
　　　j = j + 1
　　End If
　Next i
　ar(0) = ar1()　'仕切り直し
　l = LBound(ar(0)):　 u = UBound(ar(0))
　QuickSort1 ar, l, u, 0
　Stop
End Sub

'//

No.4 回答者： Picosoft 回答日時： 2014/07/03 10:53

> argAryはジャグ配列なのですが

> 一部文字列が含まれている列があるので型が合わないと怒られてしまいました

> VarTypeで見たところご推測の通り数値だけの列も文字列の8と返って来ましたが
> 列が文字列かどうかを固定で処理するのも好ましくないので
> とりあえず、最初にIsNumericを利用して数値のみの列であれば別の配列に渡して
> 間接的な処理をしようかと思うのですが他によさそうな手法があればご教授下さい。

ふむ、数値以外のデータも含まれるということですね……。

どういうデータがあるのかはわかりませんが、
以下のような出力を望んでいるのでしょうか？
　"1", "01", "2", "15", "1a", "abc", "11a" (入っているデータはこんな感じですか？)
　　　　↓ソート
　"01", "1", "1a", "2", "11a", "15", "abc"
　(辞書順にソートすると"01", "1", "11a", "15", "1a", "2", "abc"となる)

もしそうであるなら、
2つの文字列を比較して大小を判断するための自作メソッド(VB.NETでいうCompareToメソッド)を作るといいかもしれません。


例：
Function CompareStrings(ByVal str1 As String, ByVal str2 As String) As Integer
str1とstr2を比較し、以下の数を返す
・str1 < str2としたいなら負の数 (str1="1a", str2="11a"なら負の数)
・str1 = str2なら0
・str1 > str2としたいなら正の数 (str1="11a", str2="1a"なら正の数)

このようなメソッドを作っておけば、QuickSort1メソッドの修正は
　Do While argAry(sortnum)(i) < vBase
　Do While argAry(sortnum)(j) > vBase
をそれぞれ
　Do While CompareStrings(argAry(sortnum)(i), vBase) < 0
　Do While CompareStrings(argAry(sortnum)(j), vBase) > 0
と書き換えるだけで済みます。

No.3 回答者： WindFaller 回答日時： 2014/07/03 10:07

こんにちは。

QuickSort 自体を一般的なアルゴリズムにしたがって、直してみました。
これで試してみてください。

なお、掲示板にアップする時は、再現性を高めるために、もう少し説明を加えてください。
また、アップする時は、引数の説明も入れるか、Main側も書いたほうがよいです。

ただ、ジャグ配列を、言うまでもなく、Main側で、一次配列にしたほうがコードとしては分かりやすく、ミスも少なくなります。VBAでは、１次元配列が様々な関数が使えて圧倒的に便利です。

'//修正前の部分をコメントアウトしました。

Sub QuickSort1(ByRef argAry As Variant, ByVal lngMin As Long, ByVal lngMax As Long, sortnum As Integer)
　　'引数の内訳：ジャグ配列, 配列の下限, 配列の上限, ジャグ配列の一次側の添字
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim vBase As Variant
　　Dim Temp As Variant
　　'Dim vSwap() As Variant　: ReDim vSwap(UBound(argAry))
　　vBase = argAry(sortnum)(Int((lngMin + lngMax) / 2))
　　i = lngMin
　　j = lngMax
　　Do
　　　　Do While argAry(sortnum)(i) < vBase
　　　　　　i = i + 1
　　　　Loop
　　　　Do While argAry(sortnum)(j) > vBase
　　　　　　j = j - 1
　　　　Loop
　　　　If i >= j Then Exit Do
　　　　 Temp = argAry(sortnum)(i) 'Swap
　　　　 argAry(sortnum)(i) = argAry(sortnum)(j)
　　　　 argAry(sortnum)(j) = Temp
'　　　　　　For k = 1 To UBound(argAry)
'　　　　　　　　vSwap(k) = argAry(k)(i)
'　　　　　　　　argAry(k)(i) = argAry(k)(j)
'　　　　　　　　argAry(k)(j) = vSwap(k)
'　　　　　　Next
　　　　　　i = i + 1
　　　　　　j = j - 1
　　Loop
　　If (lngMin < i - 1) Then
　　　　Call QuickSort1(argAry, lngMin, i - 1, sortnum)
　　End If
　　If (lngMax > j + 1) Then
　　　　Call QuickSort1(argAry, j + 1, lngMax, sortnum)
　　End If
End Sub

No.2 回答者： taigideatta 回答日時： 2014/07/03 00:01

見当違いかもしれませんが、普通にゼロパディングすれば良いのでは？

No.1 回答者： Picosoft 回答日時： 2014/07/02 17:22

データが文字列として格納されているために辞書順のソートになっているものと思われます。

データ中には数値しかないことが保証されているのなら、
　Do While argAry(sortnum)(i) < vBase
　Do While argAry(sortnum)(j) > vBase
この2文をそれぞれ
　Do While CInt(argAry(sortnum)(i)) < CInt(vBase)
　Do While CInt(argAry(sortnum)(j)) > CInt(vBase)
と変えて、数値の大小で比較するようにしてください。
(数値がIntegerの範囲に収まらない場合は、CLng等適切な型をお使いください)

この回答へのお礼

ご回答有難うございます
argAryはジャグ配列なのですが
一部文字列が含まれている列があるので型が合わないと怒られてしまいました

VarTypeで見たところご推測の通り数値だけの列も文字列の8と返って来ましたが
列が文字列かどうかを固定で処理するのも好ましくないので
とりあえず、最初にIsNumericを利用して数値のみの列であれば別の配列に渡して
間接的な処理をしようかと思うのですが他によさそうな手法があればご教授下さい。

お礼日時：2014/07/02 18:43