Ｅｘｃｅｌ: データを各シートへ振り分ける

質問

Ｅｘｃｅｌでsheet１からsheet　nまで準備されているものとします。sheet1として(2行1列目～50行2列目）までの表があってそれを1列目を昇順でソートしたとき数個のグループに分かれるものとします。またsheet　ｎは事前にグループの分は充分用意されているものとします。
そこでソート後、そのシートを分かれたグループ仮にAAA，ＣＣＣ，ＤＤＤと分かれたときに、sheet2にはＡＡＡのグループを2行目以下へ転送し、sheet3にはＢＢＢのグルーを2行目以下へ転送し、そしてsheet4にはＣＣＣのグループを2行目以下へ転送するようにマクロ記述をしたいどのように記述すればいいですか。（マクロ実行はソート後実行します）

回答No.3

merlionXX · ベストアンサー

1行目はタイトル行なんですね？

以下、サンプルです。

Sub test01() 'A列基準にデータ分割Copy
Set dt = Sheets(1) 'データシート
Set base = dt.Range("A2") '基準点
With dt
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).Sort _
Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin 'A列を昇順でソート
n = 2
Do Until base.Offset(i).Value = "" '基準点以下にデータのある限り続ける
If base.Offset(i).Value <> base.Offset(i + 1).Value Then 'A列が同データだけ
If Not .AutoFilterMode Then .Rows("1:1").AutoFilter 'オートフィルターで抽出
.Rows("1:1").AutoFilter Field:=1, Criteria1:=base.Offset(i).Value
.Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Copy
On Error GoTo line
Set ws = Sheets(n) 'ペースト先シート
On Error GoTo 0
ws.Range("A2").PasteSpecial 'ペースト
Application.CutCopyMode = False
n = n + 1
End If
i = i + 1
Loop
.AutoFilterMode = False
End With
Exit Sub
line:
MsgBox "シートが足りないわ！", vbCritical, "（￣□￣; ？"
End Sub

お礼

なかなか高度な処理をしているため理解がおいつきません。
回答についてはどうもありがとうございました。
【追加質問】
If Not .AutoFilterMode Then .Rows("1:1").AutoFilter 'オートフィルターで抽出
.Rows("1:1").AutoFilter Field:=1, Criteria1:=base.Offset(i).Value
.Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Copy
これは、オートフィルタ機能を使って、次々にグループのデータを取り出しコピー貼り付けする処理なのですか。

補足

回答非常に感謝。きちんと動きます。詳細の検討やもっと自分の目的へのフィットはこれからですが。
dt.Rangeとか使っていますがdt.というのはＥＸＣＥＬのＶＢの方でどういう役割、使用がきまったものですか。
それともmerlionXXさんが自分で定義したものでしょうか。

回答No.6

merlionXX

> 単純に2行1列目～50行2列目の表で、ソートする基準を単にAからBに変えた。と回答します。

ならば、以下のようになります。くわしくコメントを入れなおしました。
どこが変わってるかごらんください。

Sub test02() 'B列基準にデータ分割Copy
Set dt = Sheets(1) 'データシート
Set base = dt.Range("B2") '基準点
With dt
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).Sort _
Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin 'A1～連続する使用範囲をB列基準に昇順でソート（1行目はタイトル）
n = 2
Do Until base.Offset(i).Value = "" '基準点以下にデータのある限り続ける
If base.Offset(i).Value <> base.Offset(i + 1).Value Then 'B列が同データだけ
If Not .AutoFilterMode Then .Rows("1:1").AutoFilter 'オートフィルターで抽出
.Rows("1:1").AutoFilter Field:=2, Criteria1:=base.Offset(i).Value '範囲内でB列はField:=2
.Range(.Range("A2"), .Range("A2").SpecialCells(xlLastCell)).Copy '抽出範囲をCopy
On Error GoTo line 'シート不足チェック
Set ws = Sheets(n) 'ペースト先シート
On Error GoTo 0
ws.Range("A2").PasteSpecial 'ペースト
Application.CutCopyMode = False
n = n + 1
End If
i = i + 1
Loop '繰り返し
.AutoFilterMode = False
End With
Exit Sub
line:
MsgBox "シートが足りませぬ！", vbCritical, "（￣□￣; ？"
End Sub

お礼

ご丁寧なフォロー感謝にたえません。どうもありがとうございました。
この質問で意味をより深く理解できるものとなりました。

回答No.5

merlionXX

> Ａ列でなくＢ列を基準としたときは下記でいいのでしょうか。

2行1列目～50行2列目の表で、ソートする基準を単にAからBに変えたのですか？それとも表の配置も変わるのですか？
そういうことがわからないと答えられません。
また、補足欄にペーストしたコードは改行も無く、不正な文字も入っているためテストも出来ず、何がなんだかわかりません。

補足

元元のグループで分解するというグループの値が、実はＡ列でなくＢ列に入っています。
単純に2行1列目～50行2列目の表で、ソートする基準を単にAからBに変えた。と回答します。

回答No.4

merlionXX

> dt.Rangeとか使っていますがdt.というのはＥＸＣＥＬのＶＢの方でどういう役割、使用がきまったものですか。
> それともmerlionXXさんが自分で定義したものでしょうか。

dtでもs1でもなんでもいいんですが、要はSheet(1)のことです。

>【追加質問】
これは、オートフィルタ機能を使って、次々にグループのデータを取り出しコピー貼り付けする処理なのですか。

貼り付けはその後です。コピーまでをやってます。

お礼

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

補足

ＮＯ３の回答

Ａ列でなくＢ列を基準としたときは下記でいいのでしょうか。
どこがかわるのか。Ａ１→Ｂ１　Ａ２→Ｂ２　（１；１）→（２：２）でしょうか
Sub test02() 'B列基準にデータ分割CopySet dt = Sheets(1) 'データシートSet base = dt.Range("B2") '基準点With dt.Range(.Range("B1"), .Range("B1").SpecialCells(xlLastCell)).Sort _Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _OrderCustom:=1,MatchCase:=False, rientation:=xlTopToBottom, SortMethod _:=xlPinYin 'B列を昇順でソートn = 2Do Until base.Offset(i).Value = "" '基準点以下にデータのある限り続けるIf base.Offset(i).Value <> base.Offset(i + 1).Value Then 'B列が同データだけIf Not .AutoFilterMode Then .Rows("2:2").AutoFilter 'オートフィルターで抽出.Rows("2:2").AutoFilter Field:=1, Criteria1:=base.Offset(i).Value‘fieldは１でいいか.Range(.Range("B2"), .Range("B2").SpecialCells(xlLastCell)).CopyOn Error GoTo lineSet ws = Sheets(n) 'ペースト先シートOn Error GoTo 0ws.Range("A2").PasteSpecial 'ペーストApplication.CutCopyMode = False　　‘形式を選択貼り付け　　値n = n + 1End Ifi = i + 1Loop.AutoFilterMode = FalseEnd WithExit Subline:MsgBox "シートが足りないわ！", vbCritical, "（￣□￣; ？"End Sub

回答No.2

NCU

> どのように記述すればいいですか。

？？？
具体的に何が難しいのですか？

補足

ｅｘｃｅｌ　マクロのステ-トメントの一部で

Range("A2:C11").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste

Range("A2:C11").SelectでA2の２とか、C11の11とかが、各ｉｎｔｅｇｅｒ変数のｉ,jに入っているときそのi,jを使った式だとどう記述すればいいのでしょう。

回答No.1

zap35

このくらいの行数ならコピー＆ペーストが早いかもしれませんね。

マクロで書いても、たぶん簡単なマクロですよ。takttaさんが「自分で書いたマクロでうまくいかないから教えてください」と自作のマクロをｕｐするのであれば、皆さんもこぞって協力して下さると思いますが…

補足

ＮＯ３さんの回答は、データのグループが各々どこからどこ
何行目から何行目に入っているというのを計数する代わりに
フィルター機能を使って抽出すていると思うのですが。
それは正解でしょうか。