こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel:  データを各シートへ振り分ける

Excelでsheet1からsheet nまで準備されているものとします。sheet1として(2行1列目~50行2列目)までの表があってそれを1列目を昇順でソートしたとき数個のグループに分かれるものとします。またsheet nは事前にグループの分は充分用意されているものとします。
そこでソート後、そのシートを分かれたグループ仮にAAA,CCC,DDDと分かれたときに、sheet2にはAAAのグループを2行目以下へ転送し、sheet3にはBBBのグルーを2行目以下へ転送し、そしてsheet4にはCCCのグループを2行目以下へ転送するようにマクロ記述をしたいどのように記述すればいいですか。(マクロ実行はソート後実行します)

投稿日時 - 2006-07-10 18:27:12

QNo.2267565

困ってます

質問者が選んだベストアンサー

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

投稿日時 - 2006-07-11 09:50:57

補足

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

投稿日時 - 2006-07-11 12:29:56

お礼

なかなか高度な処理をしているため理解がおいつきません。
回答についてはどうもありがとうございました。
【追加質問】
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
これは、オートフィルタ機能を使って、次々にグループのデータを取り出しコピー貼り付けする処理なのですか。

投稿日時 - 2006-07-11 14:14:29

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

> 単純に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

投稿日時 - 2006-07-11 17:56:54

お礼

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

投稿日時 - 2006-07-12 10:17:15

ANo.5

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

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

投稿日時 - 2006-07-11 16:32:46

補足

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

投稿日時 - 2006-07-11 17:31:56

ANo.4

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

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

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

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

投稿日時 - 2006-07-11 14:22:37

補足

NO3の回答

A列でなくB列を基準としたときは下記でいいのでしょうか。
どこがかわるのか。A1→B1 A2→B2 (1;1)→(2:2)でしょうか
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は1でいいか.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

投稿日時 - 2006-07-11 15:21:51

お礼

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

投稿日時 - 2006-10-16 17:08:30

ANo.2

NCU

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

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

投稿日時 - 2006-07-10 21:53:49

補足

excel マクロのステ-トメントの一部で

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


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

投稿日時 - 2006-07-11 12:08:33

ANo.1

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

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

投稿日時 - 2006-07-10 21:19:20

補足

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

投稿日時 - 2006-07-11 14:22:40

あなたにオススメの質問