アプリ版:「スタンプのみでお礼する」機能のリリースについて

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

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列以降にはデータが入っています。
宜しくお願い致します。

A 回答 (5件)

こんばんは!



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

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
    • good
    • 2
この回答へのお礼

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

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

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

お礼日時:2014/05/01 23:30

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
    • good
    • 0
この回答へのお礼

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

お礼日時:2014/05/01 23:33

こんばんは。



なぜ、以下のようなコードになるかというと、上書きが前提となるわけで、他の書き方はあるにしても、元のデータを壊さないようにするには、配列を使わざるを得ません。それと、元のデータは、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
'//
    • good
    • 0
この回答へのお礼

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

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

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

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

お礼日時:2014/05/01 23:31

ご質問の意味が、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)),".","-"),"")
    • good
    • 0
この回答へのお礼

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

お礼日時:2014/05/01 22:46

直接は無理ですね。


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列をキーに並びかえればお望みの様になります。
    • good
    • 0
この回答へのお礼

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

お礼日時:2014/05/01 22:39

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!