[[20160817214630]] 『複数ーデーターを集約させる(請求書)』(朋朋) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数ーデーターを集約させる(請求書)』(朋朋)

請求書の作成にあたりデーターを集約させるマクロを考えています。
初心者でどのようにしたらよいのか分からず困っています。
(過去検索で該当するようであれば申し訳ございません)

シート1には取引先ごとにデーターが
氏名、住所、コード、金額になっています。
順番にシート2に1人目を転記させ印刷をしたら
2人目を転記し印刷するマクロを作りたいと思います。
どのように処理したらよいのかお知恵をお借りできたらと思います。

よろしくお願いいたします。

シート1

 	A	B	C	D
 1	01田中	横浜	123	223
 2	01田中	横浜	456	444
 3	02鈴木	東京	121	555
 4	02鈴木	東京    232	666
 5	02鈴木	東京	343	777
 6	02鈴木	東京	454	888
 7	03木村	埼玉	131	999
 8	04池田	千葉	233	292
 9	04池田	千葉	558	100

シート2

1ループ目

 	A	B	
 1	01田中	横浜	
 2	123	223
 3	456	444
−印刷−

2ループ目

 	A	B	
 1	02鈴木	東京	
 2	121	555
 3	232	666
 4	343	777
 5	454	888
−印刷−

3ループ目

 	A	B	
 1	03木村	埼玉
 2	131	999
−印刷−

4ループ目

 	A	B
 1	04池田	千葉
 2	233	292
 3	558	100
−印刷−

終了

< 使用 Excel:Excel2013、使用 OS:Windows10 >


 アップされたレイアウトが、サンプル的なもので 実際には、もっと列数が多いということなら
 以下のコードの作業域の変更をしなければいけませんが、アップされたレイアウトをベースに。

 作業シートを用意してください。非表示シートにしておいてもOKです。以下のコードでは "Sheet3" にしています。
 また 印刷はテスト用にプレビューにしてありますので、★印のところ、実際には PrintOut にしましょう。

 Sub Sample()
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim shW As Worksheet
    Dim c As Range

    Application.ScreenUpdating = False

    Set shF = Sheets("Sheet1")
    Set shT = Sheets("Sheet2")
    Set shW = Sheets("Sheet3")

    shW.Cells.ClearContents

    shF.Range("A1").CurrentRegion.Copy shW.Range("A2")
    shW.Range("A1:D1").Value = Array("項目1", "項目2", "項目3", "項目4")
    shW.Range("A1").CurrentRegion.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
                                CopyToRange:=shW.Range("F1"), Unique:=True
    shW.Range("I1:J1").Value = shW.Range("C1:D1").Value

    For Each c In shW.Range("F2", shW.Range("F" & Rows.Count).End(xlUp))
        shW.Range("F2:G2").Value = c.Resize(, 2).Value
        shW.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=shW.Range("F1:G2"), CopyToRange:=shW.Range("I1:J1"), Unique:=False

        shT.Cells.ClearContents

        shT.Range("A1:B1").Value = c.Resize(, 2).Value
        shW.Range("I2", shW.Range("I" & Rows.Count).End(xlUp)).Resize(, 2).Copy shT.Range("A2")

        shT.PrintPreview    '★
    Next
 End Sub

(β) 2016/08/17(水) 22:42


(β) 様
お忙しいところ早々にアドヴァイスをありがとうございました。
作業シートを作っていくんですね。
想像もつきませんでした。
チャレンジしてみます。
感謝申し上げます。
(朋朋) 2016/08/18(木) 08:50

 >>作業シートを作っていくんですね。 

 作業シートは必須ではありません。たとえばSheet1の右のほうの未使用領域を使ってもいいんです。
 要は、処理でフィルターオプションを使っていますので、そのための作業域が少し必要だということ。

 作業シートにしておいたほうが、何かとコードが簡単になりますので。

(β) 2016/08/18(木) 10:04


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.