VBAにて 文字と数字が混在してるデータの並び替え

VBAにて、
A列に以下のようなデータがある場合、数字の小さい順に並べ替えるにはどうすればよいのでしょうか？
数字は文字として入力されている場合もあります。

２
１
本屋
９
赤
３３



結果

パターン１
このようにしたい
数字と漢字が分かれていること
1
２
９
３３
赤
本屋


パターン２
このようにしたい
数字以外の順序はどうでもよい
1
２
９
３３
本屋
赤


パターン３
これはダメ
1
２
33
９
本屋
赤

No.3 ベストアンサー 回答者： eden3616 回答日時： 2014/08/01 11:03

すいません。

コーディングがまずいですね。
最下のVBAコードを使用してください。



testプロシージャの

Debug.Print "パターン(1)"
myAry = Array("2", "1", "本屋", "9", "赤", "33")
Debug.Print "パターン(2)"
myAry = Array("2", "1", "33", "9", "赤", "本屋")
Debug.Print "パターン(3)"
myAry = Array("2", "1", "３３", "9", "赤", "本屋")

として結果（イミディウィンド出力）は以下のようになります

パターン(1)
1
2
9
33
本屋
赤
パターン(2)
1
2
9
33
本屋
赤
パターン(3)
1
2
9
３３
本屋
赤




■ＶＢＡコード

Sub test()
Dim myAry() As Variant
Debug.Print "パターン(1)"
myAry = Array("2", "1", "本屋", "9", "赤", "33")
GoSub srt
Debug.Print "パターン(2)"
myAry = Array("2", "1", "33", "9", "赤", "本屋")
GoSub srt
Debug.Print "パターン(3)"
myAry = Array("2", "1", "３３", "9", "赤", "本屋")
GoSub srt
Exit Sub
srt:
Call QuickSort1(myAry, LBound(myAry), UBound(myAry))
For i = 0 To UBound(myAry)
Debug.Print myAry(i)
Next i
Return
End Sub

Sub QuickSort1(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long)
Dim i As Long
Dim j As Long
Dim vBase As Variant
Dim vSwap As Variant
Dim tmp(2) As Variant
vBase = argAry(Int((lngMin + lngMax) / 2))
i = lngMin
j = lngMax
Do

'比較
Do
'型変換
If IsNumeric(argAry(i)) Then tmp(0) = CDbl(argAry(i)) Else tmp(0) = CStr(argAry(i))
If IsNumeric(vBase) Then tmp(2) = CDbl(vBase) Else tmp(2) = CStr(vBase)
'判定
If tmp(0) >= tmp(2) Then Exit Do
i = i + 1
Loop
Do
'型変換
If IsNumeric(argAry(j)) Then tmp(1) = CDbl(argAry(j)) Else tmp(1) = CStr(argAry(j))
If IsNumeric(vBase) Then tmp(2) = CDbl(vBase) Else tmp(2) = CStr(vBase)
'判定
If tmp(1) <= tmp(2) Then Exit Do
j = j - 1
Loop

If i >= j Then Exit Do
vSwap = argAry(i)
argAry(i) = argAry(j)
argAry(j) = vSwap
i = i + 1
j = j - 1
Loop
If (lngMin < i - 1) Then
Call QuickSort1(argAry, lngMin, i - 1)
End If
If (lngMax > j + 1) Then
Call QuickSort1(argAry, j + 1, lngMax)
End If
End Sub

この回答へのお礼

回答ありがとうございます。
うまくいきましたぁ。

お礼日時：2014/08/02 07:04

No.2 回答者： eden3616 回答日時： 2014/07/31 09:44

表示をオフにして新規シートを作成してセルに書き出し、

エクセルの並び替え機能をVBAで並び替えてから配列へ戻してシートを削除・・・・
が高速でシンプルにすみますが。

コード内で処理を行いたいのであれば配列ののクイックソートをどうぞ。

「test」を実行してください。
以下のサイトのクイックソートをベースにしています。
http://excel-ubara.com/excelvba5/EXCELVBA229.html

上記サイトのものですと文字列比較ですので1,2,33,9・・・となりますが、
数値と判定出来るものは数値として比較するようにすれば以下のような結果になります。

1
2
9
33
本屋
赤

1次元配列にしか対応していませんので、
2次元配列の場合は上記サイトを参考に同様に変更してみてください。



■VBAコード

Sub test()
Dim myAry() As Variant
myAry = Array("2", "1", "本屋", "9", "赤", "33")
Call QuickSort1(myAry, LBound(myAry), UBound(myAry))
For i = 0 To UBound(myAry)
Debug.Print myAry(i)
Next i
End Sub



Sub QuickSort1(ByRef argAry() As Variant, ByVal lngMin As Long, ByVal lngMax As Long)
Dim i As Long
Dim j As Long
Dim vBase As Variant
Dim vSwap As Variant
vBase = argAry(Int((lngMin + lngMax) / 2))
'数値なら数値型へ変更
If IsNumeric(vBase) Then vBase = CDbl(vBase)
i = lngMin
j = lngMax
Do
'数値なら数値で比較
If IsNumeric(vBase) Then
Do While CDbl(argAry(i)) < vBase
i = i + 1
Loop
Do While CDbl(argAry(j)) > vBase
j = j - 1
Loop
'文字で比較
Else
Do While argAry(i) < vBase
i = i + 1
Loop
Do While argAry(j) > vBase
j = j - 1
Loop
End If
If i >= j Then Exit Do
vSwap = argAry(i)
argAry(i) = argAry(j)
argAry(j) = vSwap
i = i + 1
j = j - 1
Loop
If (lngMin < i - 1) Then
Call QuickSort1(argAry, lngMin, i - 1)
End If
If (lngMax > j + 1) Then
Call QuickSort1(argAry, j + 1, lngMax)
End If
End Sub

この回答への補足

回答ありがとうございます。


myAry = Array("2", "1", "33", "9", "赤", "本屋")
このように、本屋と33を入れ替えて実行しますと、次のようなエラーが出てしまいました。


'数値なら数値で比較
If IsNumeric(vBase) Then
Do While CDbl(argAry(i)) < vBase
i = i + 1
Loop
Do While CDbl(argAry(j)) > vBase　←エラー　型が一致しません
j = j - 1
Loop




myAry = Array("2", "1", "本屋", "9", "赤", "３３")
また、このように"33"を全角"３３"にすると、３３が数字の小さい順として並びませんでした。


1
2
9
本屋
赤
３３


改善できるようでしたら、よろしくお願いいたします。

数字と文字の判定方法および数字を数値に変える方法が分かりましたので、大変参考になりました。

補足日時：2014/08/01 08:48

No.1 回答者： tom04 回答日時： 2014/07/18 16:24

こんにちは！

一例です。
データはA1セルからあるとします。

Sub 並び替え()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range("A:A").Insert
With Range(Cells(1, "A"), Cells(lastRow, "A"))
.Formula = "=ASC(B1)"
.Value = .Value
End With
Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo
Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答への補足

回答ありがとうございます。

質問が悪く申し訳ないのですが、
シート上で並べ替えるのではなく、
配列に格納されたデータを並べ替えたかったのです。
どうもすみません。

補足日時：2014/07/18 20:11