エクセル 2010 マクロ ハイフン 並べ替え

質問

途中にハイフンが入る文字列の並べ替えをマクロを使用して教えてください。

A2からA列に入力されている最下位セルまでを見つけて(今回はA10まで)

A2・・・2
A3・・・5-8
A4・・・1
A5・・・3-4
A6・・・1-2
A7・・・10-11
A8・・・12-13
A9・・・10
A10・・9

上記の並びを下記のようにしたいのですが出来ますでしょうか？

A2・・・1
A3・・・1-2
A4・・・2
A5・・・3-4
A6・・・5-8
A7・・・9
A8・・・10
A9・・・10-11
A10・・12-13

B列以降にはデータが入っています。
宜しくお願い致します。

回答No.4

tom04 · ベストアンサー

こんばんは！

普通の並び替えで良いのであれば一例です。

Sub 並び替え()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range("A:A").Insert
With Range(Cells(2, "A"), Cells(lastRow, "A"))
.Formula = "=IF(ISNUMBER(FIND(""-"",B2)),LEFT(B2,FIND(""-"",B2)-1)*1,B2*1)"
.Value = .Value
End With
Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

質問文をよくよく読んでみると、A列のみ並び替えをしたい！という意味にも読み取れますので
他の列はそのままの状態にしたい場合は
↓のコードにしてみてください。

Sub A列のみ並び替え()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range("A:A").Insert
Range("C:C").Insert
With Range(Cells(2, "A"), Cells(lastRow, "A"))
.Formula = "=IF(ISNUMBER(FIND(""-"",B2)),LEFT(B2,FIND(""-"",B2)-1)*1,B2*1)"
.Value = .Value
End With
Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
Range("C:C").Delete
Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

普通の並び替えでいいんです。
ただし、ハイフンがネックだったので
ハイフンを.(小数点)に置換してみたりしたのですが、
どうも思うような結果が得られず、苦戦してました。

No.5の補足回答に修正したところ
思うような結果が得られ、且つシンプルなため
ベストアンサーに選ばさせていただきました。

ありがとうございました。

回答No.5

tom04

No.4です。
たびたびごめんなさい。

前回のコードで1行間違っていました。

＞.Formula = "=IF(ISNUMBER(FIND(""-"",B2)),LEFT(B2,FIND(""-"",B2)-1)*1,B2*1)"
の行を
＞.Formula = "=IF(ISNUMBER(FIND(""-"",B2)),LEFT(B2,FIND(""-"",B2)-1)*1000+MID(B2,FIND(""-"",B2)+1,3),B2*1000)"
に変更してください。

※　ハイフン以降は最大3桁までとしています。
※　関数でやる方法を単純にコードにしただけです。m（_ _）m

お礼

※部がありがたいコメントです。

回答No.3

WindFaller

こんばんは。

なぜ、以下のようなコードになるかというと、上書きが前提となるわけで、他の書き方はあるにしても、元のデータを壊さないようにするには、配列を使わざるを得ません。それと、元のデータは、0サフィックスになっていますから、余計にややこしいです。これが、一定の桁の決まりのある数字ならよいのですが、そいういう前提が書かれていません。一応、バブルソート・アルゴリズムを利用しました。
なんとなく、達成感がありませんから、実際のデータでは、*の部分に間違いがあるかもしれません。

'//
Sub SpecialSort()
　Dim Rng As Range
　Dim i As Long
　Dim j As Long
　Dim c As Variant
　Dim Nums As Variant
　Dim Ar0() As Variant
　Dim Ar1() As Variant
　Dim Ar2() As Variant
　Const CL As String = "A" '書き出し列
　'範囲
　Set Rng = Range("A2", Cells(Rows.Count, 1).End(xlUp))
　Ar0 = Application.Transpose(Rng.Value)
　ReDim Ar1(Rng.Rows.Count - 1, 1)
　For Each c In Rng
　　Nums = Split(c.Text, "-")
　　If UBound(Nums) = 0 Then
　　　Ar1(i, 0) = Format(Nums(0), "00") & "00"　'*
　　Else
　　　Ar1(i, 0) = Format(Nums(0), "00") & Format(Nums(1), "00")　'*
　　End If
　　Ar1(i, 1) = i + 1
　　i = i + 1
　Next c
　Ar2 = BabbleSort(Ar1())
　j = 2 '書き出し初期値行
　For i = 0 To UBound(Ar2(), 1)
　　Cells(j, CL).Value = "'" & Ar0(Ar2(i, 1))
　　j = j + 1
　Next i
End Sub
Function BabbleSort(Ar() As Variant)
　'パラメータは、2次元配列
　Dim u As Long
　Dim i As Long
　Dim j As Long
　Dim t1 As Variant
　Dim t2 As Variant
　u = UBound(Ar(), 1)
　i = LBound(Ar(), 1)
　Do While i < u
　　j = u
　　Do While j > i
　　　If Ar(j, 0) < Ar(i, 0) Then '昇順
　　　　t1 = Ar(j, 0)
　　　　t2 = Ar(j, 1)
　　　　Ar(j, 0) = Ar(i, 0)
　　　　Ar(j, 1) = Ar(i, 1)
　　　　Ar(i, 0) = t1
　　　　Ar(i, 1) = t2
　　　End If
　　　j = j - 1
　　Loop
　　i = i + 1
　Loop
　BabbleSort = Ar()
End Function
'//

お礼

いつもありがとうございます。
実際のデータで動かしてみましたところ
確かに思うような結果が得られました。

サフィックス・・・とか
バブルソート・・・など、VBA無知な私には
コードよりも言葉の勉強になります。（苦笑）

作業列に関数を使った教えのサイトはいくつかあるものの
今回マクロのみでご教示いただいたことは
今後、同じような悩みを抱く人達に　とても役に立つコードかと思われます。

ベストアンサー10pt制度があれば・・・

回答No.2

MackyNo1

ご質問の意味が、VBAを使って、通常の並べ替え操作のようにリスト全体を並べ替えたいということなら、かなり大がかりなプログラムを組む必要がありそうです。

このようなケースでは、すでに回答があるように関数で補助列に並べ替えに対応できる形にデータ処理をするのが実用的な方法です。

この場合、補助列に以下のような数字に変更した数式を入力するのががわかりよいかもしれません。

=SUBSTITUTE($A$2:INDEX(A:A,COUNTA(A:A)),"-",".")*1

ご希望の操作が、リストの並べ替えではなく、別シートなどに昇順に並べ替えたデータを表示したということなら以下のような関数でご希望の順のリストを作成することができます。

=IFERROR(SUBSTITUTE(SMALL(INDEX(SUBSTITUTE($A$2:INDEX(A:A,COUNTA(A:A)),"-",".")*1,),ROW(1:1)),".","-"),"")

お礼

やはり作業列を設けないと容易にはいかないのが分かりました。
幾つかのサイトを見ても　ハイフンが入る文字列のマクロ(VBA)での並べ替えが
ヒットしなかったのですが、諦めきれずにダメ元で投稿しました。
しかしながら、的確な関数と、また別の視点からの提案は今後の参考とさせていただきます。
ありがとうございました。

回答No.1

mshr1962

直接は無理ですね。
A2・・・02
A3・・・05-8
A4・・・01
A5・・・03-4
A6・・・01-2
A7・・・10-11
A8・・・12-13
A9・・・10
A10・・09
なら可能ですけど。。。

並べ替え用の列を作っていいならB2に
=IF(COUNTIF(A2,"*-*"),TEXT(LEFT(A2,FIND("-",A2)-1),"00!-")&TEXT(RIGHT(A2,LEN(A2)-FIND("-",A2)),"00"),TEXT(A2*1,"00"))
を入力して下方にコピーで

B2・・・02
B3・・・05-08
B4・・・01
B5・・・03-04
B6・・・01-02
B7・・・10-11
B8・・・12-13
B9・・・10
B10・・09

となりB列をキーに並びかえればお望みの様になります。

お礼

ありがとうございます。
作業列を設けて桁数を揃える。ということですね。
ただし桁数を揃えたあとの　0始まりは希望するものと違うので
これはこれで参考とさせていただきます。