EXCELの並び替えについて

はじめまして。
表が自動的に並び替えれないか四苦八苦しております。
例えば、
1AB、1BD、2EF、3HI…
と、続く表があるのですが、違うシートに表を作り、1から始まる値、2から始まる値をそれぞれ表に抽出していきたいのですが、全くわかりません。
いったいどうしたらいいのでしょう？
教えていただけたら幸いです。

No.2 ベストアンサー 回答者： tom04 回答日時： 2014/10/05 21:40

こんばんは！

VBAでの一例です。

＞例えば、
＞1AB、1BD、2EF、3HI…
＞と、続く表があるのですが

元データは↓の画像のような配置でSheet1にあるとします。
（A列に抽出したいデータが入っている）

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, k As Long, lastRow As Long, lastCol As Long, str As String
With Worksheets(1)
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
.Range("A:B").Insert
.Range("B1") = "ダミー"
For i = 2 To lastRow
For k = 1 To Len(.Cells(i, "C"))
str = Mid(.Cells(i, "C"), k, 1)
If StrConv(str, vbNarrow) Like "[0-9]" Then
.Cells(i, "B") = .Cells(i, "B") & str
Else
Exit For
End If
Next k
Next i
.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Range("A1"), unique:=True
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If Worksheets.Count < i Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
End If
If Worksheets(i).Name <> .Cells(i, "A") Then
Worksheets(i).Name = .Cells(i, "A")
Worksheets(i).Cells.Clear
.Range("A1").AutoFilter field:=2, Criteria1:=.Cells(i, "A")
Range(.Cells(1, "C"), .Cells(lastRow, lastCol + 2)).SpecialCells(xlCellTypeVisible).Copy Worksheets(i).Range("A1")
End If
Next i
.AutoFilterMode = False
.Range("A:B").Delete
Application.ScreenUpdating = True
End With
End Sub 'この行まで

※　A列数値は必ず最初に入っているとします。
※　Sheet1のデータ変更があるたびにマクロを実行する必要があります。m(_ _)m

この回答へのお礼

ありがとうございます！
わざわざ画像までいただいて！
参考にさせていただいて、頑張ってみます！

お礼日時：2014/10/05 22:27

No.1 回答者： bin-chan 回答日時： 2014/10/05 19:35

タイトルには「並び替え」とあるが、内容みてたらどこにも無いみたい。

[抽出だけなら]
VBAで、
オートフィルタを設定・操作して、
可視セルのみをコピーして、
別シートヘ貼付、
をループさせる。

[並び替えがすべて同じ条件なら]
VBAで、
データの並び替えをして、
オートフィルタを設定・操作して、
可視セルのみをコピーして、
別シートヘ貼付、
をループさせる。

この回答へのお礼

素早い回答ありがとうございます！
参考にさせていただいて、頑張ってみます！

お礼日時：2014/10/05 22:25