[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『項目毎に印刷を連続して行いたいのです』(yomogi)
こんちには、宜しくお願い致します。
以下の様なデータが入力されているシートがあり、項目ごとに印刷を連続して行いたいと思っております。
指定する項目には、100種類ほどあり、ソートしてコピペでは非常に時間がかかってしまい、毎日の作業なので効率を考えてマクロ化したいと思っています。
マクロ知識は超初心者ですが、どうぞお助けください。
A列 B列 C列 D列 E列 [1] 事業所記入欄 [2] [3] [4] [5] 通番 資産番号 資産所属 資産原価コード 確認欄 [6] 1 1001 A支店 11111 [7] 2 1002 E支店 44444 [8] 3 1003 D支店 33333 [9] 4 1004 A支店 11111 [10] 5 1005 C支店 55555 [11] 6 1006 C支店 22222 [12] 7 1007 B支店 11111 [13] 8 1008 B支店 22222 [14] 9 1009 E支店 77777 [15] 10 1010 D支店 33333 [16] 11 1011 C支店 66666 [17] 12 1012 A支店 55555 [18] 13 1013 D支店 77777 [19] 14 1014 C支店 66666 [20] 15 1015 E支店 33333 [21] 16 1016 D支店 44444 [22] 17 1017 B支店 22222 ・ ・ ・ ・ [2000]
・分割したシートを保存する必要はありません。
・印刷をマクロ実行すれば、支店毎のシートが全支店分が一気に印刷したいのです。
・元データ(sheet1)書式(枠線・セル幅・フォント・印刷範囲 等)を引き継ぎたい。
・今後も複数の人が使えるよう、イメージとして、マクロ実行時に
1)「行」「列」を指定するインプットボックスが出る。
※レイアウト変更により開始データ行(タイトル行)か変わる可能性あり =指定した行の上の行部分は分割されたシートすべてにヘッダーとして残したい。
※抽出条件が変わる可能性あり(支店分割⇒原価コード分割等)
2)上記を入力して「OK」ボタンを押すとマクロが実行され、次々と印刷される。
上記のようなものは作れるのでしょうか。
説明が下手で申し訳ありません。
わかる方、教えてください。
よろしくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
1)application.inputboxで支店名の列を選択し
2)「重複の削除」で支店名リストを作成し
3)リストから支店名を1つずつ取り出し
4)オートフィルターを実行・印刷
(マナ) 2018/01/27(土) 18:45
(マナ) 2018/01/27(土) 23:27
なるほどです。
ちなみに私はマクロプログラム作成は未経験者ですので、
一つ一つ教示ください。
>1)application.inputboxで支店名の列を選択し
とありますが、そもそもどのくらいなのプラグラムを作成するのでしょうか?
「application.inputbox」なんて初耳です!
宜しくお願い致します。
(yomogi) 2018/01/28(日) 00:58
おそくまで、頑張っておられますね。
>「application.inputbox」なんて初耳です!
https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/application-inputbox-method-excel?f=255&MSPPError=-2147217396
が参考になるでしょう。
上達するコツ。。。
ここで教わった事(自分が知らない事)は、ネットで検索して納得がいくまで調べまくりましょう。
例 vba application.inputbox とコピペして検索でわんさか、情報が。。。MSDN(マイクロソフト)
とか、Moug、ここの学校、田中事務所、エクセルの神髄、Excelでお仕事、インストラクターネタ帳
等等。。。なんか私はよくのぞいています。
基本は押さえておきましょう
☆VBE操作
☆変数、型、宣言、定数
☆四則演算 算数
☆論理演算 条件分岐
☆ループ
最初は何でも、コード書いて、。。。。試しに、動かしてみよう! ^^;
必ずバックアップは取りましょう。
何度もひどい目にあってる、じーさんの独り言。
それくらい、わかってる。。! でしたら お許しを
大作に挑戦してください。
でわ
(隠居じーさん) 2018/01/28(日) 07:00
・1〜6行目をタイトル行に設定
・A列で可視行に連番になるように数式を設定
そのうえで、
・A支店でフィルター実行
・印刷
これで希望の結果が得られるなら
マクロで、全支店について繰り返せばよいのです。
(マナ) 2018/01/28(日) 10:27
(マナ) 2018/01/28(日) 10:33
ご指導や励まし有難うございます!
コツコツとやってみたいと思います。
おそらく私がいま作成しようと思っているものは「大作」でもなんでもなく
出来る方からみれば「ちょちょいのチョイ」なのでしょうが、
今の私には「エベレスト」より高い難易度です。
これを機会に勉強してみます。
(yomogi) 2018/01/28(日) 13:46
はい、最初の回答時点で、コードは出来ています。
>今の私には「エベレスト」より高い難易度です。
完成コードをいきなり見てもチンプンカンプンかもしれませんが
手作業ならどうするかイメージ出来たあとであれば
コードの意味を理解しやすいと思います。
なので、まずは手作業で出来ることを確認してください。
マクロについて考えるのは、それが出来てからです。
さらに言えば、
>開始データ行(タイトル行)か変わる可能性
とか
>抽出条件が変わる可能性
とか
>リスト選択(支店数)が100以上もある
といった変動要因は後回しにして
A支店だけについて印刷するマクロを考えてください。
手作業で出来るのだから、「マクロの記録」が参考になります。
一度に完成形を求めるから難しいのであって
少しずつならきっと出来ると思います。
(マナ) 2018/01/28(日) 15:06
作業内容
1) 1〜5行目をタイトル行に設定
2) A6に「SUBTOTAL」関数を使って数式入力、その後データのある行までコピー
3) 項目行(5行目)にオートフィルタを設定
4) 「資産所属(支店)」を「A支店」でソート実行
5) 印刷実行(PDF出力となっていましたので保存せず、キャンセルしました)
そのコードがこちらです。
中身を見ても意味がさっぱりわかりませんが、
これからいろいろ参考文献を確認したいと思います。
===========================================
Sub Macro6()
'
' Macro6 Macro
'
'
Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "$1:$5" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "" Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.708661417322835) .RightMargin = Application.InchesToPoints(0.708661417322835) .TopMargin = Application.InchesToPoints(0.748031496062992) .BottomMargin = Application.InchesToPoints(0.748031496062992) .HeaderMargin = Application.InchesToPoints(0.31496062992126) .FooterMargin = Application.InchesToPoints(0.31496062992126) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True Range("A6").Select ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,R5C[1]:R[-1]C[1])" Selection.AutoFill Destination:=Range("A6:A54"), Type:=xlFillDefault Range("A6:A54").Select ActiveWindow.SmallScroll Down:=-54 Range("A5:E5").Select Selection.AutoFilter ActiveSheet.Range("$A$5:$E$53").AutoFilter Field:=3, Criteria1:="A支店" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End Sub
============================================
よろしくお願いいたします。
(yomogi) 2018/01/28(日) 19:14
念のため確認です。
2ページ以降のタイトル行は1〜5行でよかったですか。
もしかして5行目だけでしたか。
(マナ) 2018/01/28(日) 19:56
>1)タイトル行設定と数式設定は手作業で1回実行で十分です。(マクロ不要)
つまり、
Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "$1:$5" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "" Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.708661417322835) .RightMargin = Application.InchesToPoints(0.708661417322835) .TopMargin = Application.InchesToPoints(0.748031496062992) .BottomMargin = Application.InchesToPoints(0.748031496062992) .HeaderMargin = Application.InchesToPoints(0.31496062992126) .FooterMargin = Application.InchesToPoints(0.31496062992126) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlPortrait .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True
が不要ということですね。(考えてみればそうでした...)
>2)Subtotalの式は、リンク先の最後にある対策が必要です。
少し意味がわかりません。つまり最後のデータの行まで数式を入れておく
ということでしょうか?
>3)またデータが増えても対応できるように多めに設定しておくとよいです。
2)で確認いただいたことから考えますと、データが増えてもいいように、
空白の行まで数式を入力しておくということでしょうか?
>2ページ以降のタイトル行は1〜5行でよかったですか。
もしかして5行目だけでしたか。
項目行(5行目)、だけなく2枚目以降もすべての印刷物に、
1〜5行目まで印字することを考えています。
この次は、フィルタを次々に「選択→印刷」の作業になるのでしょうか?
よろしくお願いいたします。
(yomogi) 2018/01/28(日) 20:28
=IF(B6="","",SUBTOTAL(3,B$6:B6))
これを、例えば、10000行までいれておきます。
多めにしておけば、データ数を気にしなくてよいので
マクロも簡潔になるメリットがあります。
不具合がでないか手作業で確認してみてください。
>この次は、フィルタを次々に「選択→印刷」の作業になるのでしょうか?
マクロの記録はあくまで参考で、そのまま使うものではありません。
A支店を抽出し、印刷するマクロを完成させてからです。
(マナ) 2018/01/28(日) 20:49
> Range("A5:E5").Select > Selection.AutoFilter > ActiveSheet.Range("$A$5:$E$53").AutoFilter Field:=3, Criteria1:="A支店"
「.AutoFilter Field:=3, Criteria1:=」
適当に、この部分をキーワードにして、検索します。
そうすると、最初のほうでこんなの見つかります。
http://officetanaka.net/excel/vba/tips/tips155.htm
ここを読むと、↓だけでよいことがわかります。
Range("$A$5:$E$53").AutoFilter 3, "A支店"
次にマクロの記録で印刷はここです。
> ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ > IgnorePrintAreas:=False
「 ActiveWindow.SelectedSheets.PrintOut Copies:=1」
をキーワードにして、検索しました。
こんなの見つかりました。
http://excel-ubara.com/excelvba2/EXCELVBA024.html
すると、↓だけでよいと書いてあります。
ActiveSheet.PrintOut
ということで、A支店を抽出して印刷するマクロは
これでできるはずです。
Sub test()
Range("$A$5:$E$53").AutoFilter 3, "A支店" ActiveSheet.PrintOut
End Sub
確認してみてください。
(マナ) 2018/01/28(日) 21:11
Sub test2()
Dim データ範囲 As Range
Set データ範囲 = Range("$A$5:$E$53")
データ範囲.AutoFilter 3, "A支店" ActiveSheet.PrintOut
End Sub
ついでに、データ範囲は、大は小を兼ねるで広げておきます。
また、3とか"A支店"というのも変動するので、これも変数にします。
Sub test3() Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
これが、A支店を抽出し印刷するマクロです。
動作確認してみてください。
ここまで理解でしましたか。
(マナ) 2018/01/28(日) 21:21
========================================
Sub マナ先生()
Application.PrintCommunication = True Range("A6").Select ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",SUBTOTAL(3,R6C[1]:RC[1]))" Selection.AutoFill Destination:=Range("A6:A10000"), Type:=xlFillDefault Range("A6:A10000").Select ActiveWindow.SmallScroll Down:=-54 Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
===================================
仕事の合間に拝見しながら、勉強させていただいておりますので、
返信にお時間がかかりますが、引き続き、どうぞよろしくお願いいたします。
(yomogi) 2018/01/28(日) 23:19
ということだから、数式も予めsheet1のA列に入力しておけばよいのでは?
わざわざマクロで入力する必要があるのですか。
(マナ) 2018/01/29(月) 18:57
==========================================
Sub マナ先生()
Application.PrintCommunication = True ActiveWindow.SmallScroll Down:=-54 Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
=====================================
いかがでしょうか。
(yomogi) 2018/01/31(水) 07:35
というか、手作業で1回実行するだけのことは
毎回、マクロで同じことをする必要がないという意味です。
↓この2行は、必要ありません。
> Application.PrintCommunication = True > ActiveWindow.SmallScroll Down:=-54
あと、「先生」はやめてください。
(マナ) 2018/01/31(水) 21:29
容易な言葉で説明いただけていますので、よくわかりました。有難うございます。
なるほど、プリンターの有効定義と有効データのスクロールダウンは「省略可」という意味でしょうか?
とすると、こんな短いプログラムになってしまいました。
マクロ実行しても、ここまでは全く問題ありません。驚きです。
============================================
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
========================================
次は、この抽出列や抽出条件に変数が可能なプログラムを仕組むということに
なるのでしょか?
よろしくお願いいたします。
(yomogi) 2018/01/31(水) 23:52
>1)application.inputboxで支店名の列を選択し >2)「重複の削除」で支店名リストを作成し >3)リストから支店名を1つずつ取り出し >4)オートフィルターを実行・印刷
次に、2)について考えます。
以下を手作業で実行してみてください。
支店名の一覧をZ列に作成できます。
1)範囲C5:C10000をコピーして
2)印刷範囲の設定外の適当なセル(例えばZ1)に貼付け
3)「データ」タブの「重複の削除」を実行
「重複の削除」がわからなければ、ネット検索してみてください。
(マナ) 2018/02/01(木) 21:25
=============================================
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub Sub Macro4() ' ' Macro4 Macro '
'
Range("C6:C10000").Select Selection.Copy ActiveWindow.ScrollColumn = 2 ActiveWindow.SmallScroll ToRight:=12 ActiveWindow.SmallScroll Down:=-3 Range("Z1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("Z:Z").Select Application.CutCopyMode = False ActiveSheet.Range("$Z$1:$Z$10000").RemoveDuplicates Columns:=1, Header:= _ xlNo ActiveWindow.LargeScroll ToRight:=-2 Range("A4").Select End Sub ============================================ (yomogi) 2018/02/01(木) 23:57
「値貼付け」していますが、何か理由はありますか。
(マナ) 2018/02/02(金) 23:15
印刷だけですよね?
集計機能を使えば
支店ごとに改ページも入れられますよ?
手動でしても大した作業量ではないとおもいますが、
「だれでも、間違いなく確実に」ということならマクロ化も有効でしょう。
マクロの記録からしてみては?
流れ的には、
シートを新しいブックにコピー
並び替え(支店毎等)
集計(小計行が不要ならクリアする。ジャンプ機能で数式のある行か空白のある行を検索)
印刷(タイトル行の設定をする。事前にしてあれば不要)
新しいブックを保存せずに閉じる
というような感じで実現できそうですが。。。
(まっつわん) 2018/02/03(土) 10:04
はい。Z列に作成したリストは、最後に削除してしまう予定です。 なので、今回は、単純にコピー貼付けにします。 そのほうがコードも簡単という理由です。 (値貼付けでも問題はないです)
で、コピー貼付けのマクロはこうです。
http://excel-ubara.com/excelvba1r/EXCELVBA513.html
Range("C6:C10000").Copy Range("Z1")
--
重複の削除のマクロは
https://excwlvba.blogspot.jp/2013/06/removeduplicates.html
> ActiveSheet.Range("$Z$1:$Z$10000").RemoveDuplicates Columns:=1, Header:= _ > xlNo このままでも大丈夫ですが 列全体で実行しても同じで、コードも簡潔になるので 対象範囲をColumns("Z")にしました 1行目は見出しなので、Header:= xlYesとしました Columns("Z").RemoveDuplicates Columns:=1, Header:= xlYes
--
つまり、支店名のリストを作成は2行でできます。
確認してみてください。
--
これで4つのマクロを作りました。
・オートフィルタのマクロ ・印刷のマクロ ・コピー貼付けのマクロ ・重複の削除のマクロ
こんな感じで、部品マクロを一つずつ考えていき
組み合わせることで、最終的に目的のことを実現できます。
ここまで理解できていれば、次に進めます。
--
次は、リストに基づきオートフィルタを繰り返すマクロです。
繰り返しのマクロは、For〜Nextを使います。
まずは、ネットで検索して、トライしてください。
(マナ) 2018/02/03(土) 17:28
まっつわん様
ご指導有難うございます。
普通にエクセルで出来るのですね!?まさに驚きでした!
やってみましたが、よくわかりませんでしたので、
もう少し詳しく教えていただければありがたく存じます。
エクセルも奥が深く、勉強続けます。
ただ今回は、あえてマクロの勉強を始めたいと思っておりますので、
このままマクロの完成を目指すつもりです。
有難うございました。
マナ様
いつもお世話になります。
ご指導有難うございます。
じっくり目を通せておりませんが、内容を深く読み込み
引き続き、作成にかかりたいと思います。
また、作成後のご報告をさせていただきたいと思いますので、
引き続き、よろしくお願い致します。
(yomogi) 2018/02/06(火) 23:09
https://allabout.co.jp/gm/gc/297835/
どぞ
(まっつわん) 2018/02/07(水) 09:01
「様」はやめてください。
「さん」付けでいいですよ^^
かしこまらなくていいです。
一緒にエクセルを勉強している仲間でいいのでは?
学校という名前になってますが、
知らない人が質問する。
ちょっと先に勉強した人が、知らない人に教える。
そういう情報の共有の場と考えていいと思います。
とはいえ、教えを乞うならば、
礼儀とかマナーとかは一応守らないと、、、、
皆人間なので、あいてに不快な思いをさせては、
回答が貰えなくなって、必要な情報が得られなくなります。^^;
(まっつわん) 2018/02/07(水) 09:20
マナ様
途中で作成が止まっていますが、まだあきらめておりません。
この土日には、少し前進するよう、いろいろググって試したいと思います。
簡単なマクロにも関わらず、かなりの時間をかけてしまっていることが、
お恥ずかしい限りです。
引き続き、ご指導よろしくお願いいたします。
(yomogi) 2018/02/16(金) 00:42
したがいまして、少し修正したのですが、いかがでしょうか?
よろしくお願いいたします。
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
' Macro4 Macro ' ' Range("C6:C10000").Select Selection.Copy ActiveWindow.ScrollColumn = 2 ActiveWindow.SmallScroll ToRight:=12 ActiveWindow.SmallScroll Down:=-3 Range("Z1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("Z:Z").Select Application.CutCopyMode = False ActiveSheet.Range("$Z$1:$Z$10000").RemoveDuplicates Columns:=1, Header:= _ xlNo ActiveWindow.LargeScroll ToRight:=-2 Range("A4").Select
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 抽出条件 = "A支店"
データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
いかがでしょうか?
(yomogi) 2018/02/16(金) 00:54
全く、気にすることないです。
完成形は、どうでもよいと思っているくらいです。必要ならいつでも提示します。
そうしないのは、今は、まずは部品マクロを理解することが重要と思うからです。
2018/02/03(土) 17:28に戻って、考えてください。
(マナ) 2018/02/16(金) 23:40
Sub フィルタを繰り返すマクロ()
'
' オートフィルタを繰り返すマクロ Macro
Dim i As Long
For i = z1 To z100
ActiveCell.FormulaR1C1 = i ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=i", _ Operator:=xlAnd Next i
End Sub
どこが不具合なのでしょうか?
よろしくお願いいたします。
(yomogi) 2018/02/18(日) 02:05
1)印刷のマクロ
印刷範囲とかタイトル行の設定を 事前に手作業でしておけば この1行でOKです。
ActiveSheet.PrintOut
2)コピー貼付けのマクロ
(構文) コピーする範囲.Copy 貼り付け先
つまり、これも1行でOKでです。
Range("C6:C10000").Copy Range("Z1")
3)重複の削除のマクロ
Z列のデータで重複の削除を実行するなら、こうです。 これも1行で書けます。
Columns("Z").RemoveDuplicates Columns:=1, Header:= xlYes
4)オートフィルタのマクロ
(構文) データ範囲.AutoFilter 絞り込む列番号, 絞り込む条件
なので、「データ範囲の3列目がA支店」を抽出するなら、
Range("$A$5:$E$10000").AutoFilter 3, "A支店"
'---
ここまで、しっかりと理解してください。
これらを組み合わせてマクロを完成させます。
(マナ) 2018/02/18(日) 11:00
Range("C6:C10000").Copy Range("Z1") Columns("Z").RemoveDuplicates Columns:=1, Header:= xlYes
このZ列のデータを使ってオートフィルタ、印刷を繰り返せば
目的の作業が実現できます。
ここまで理解できますか。
(マナ) 2018/02/18(日) 11:08
繰り返しのマクロは、For〜Nextを使います。 が出来ていません。なんとなくイメージはできるのですが・・・
Sub オートフィルタを繰り返すマクロ()
'
' オートフィルタを繰り返すマクロ Macro
'
'
Range("Z1").Select ActiveCell.FormulaR1C1 = "A支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=A支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z2").Select ActiveCell.FormulaR1C1 = "E支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=E支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z3").Select ActiveCell.FormulaR1C1 = "D支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=D支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z4").Select ActiveCell.FormulaR1C1 = "C支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=C支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z5").Select ActiveCell.FormulaR1C1 = "B支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=B支店", _ Operator:=xlAnd ActiveSheet.PrintOut End Sub
(yomogi) 2018/02/18(日) 18:50
Sub オートフィルタを繰り返すマクロ()
'
' オートフィルタを繰り返すマクロ Macro
'
'
Range("Z1").Select ActiveCell.FormulaR1C1 = "A支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=A支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z2").Select ActiveCell.FormulaR1C1 = "E支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=E支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z3").Select ActiveCell.FormulaR1C1 = "D支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=D支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z4").Select ActiveCell.FormulaR1C1 = "C支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=C支店", _ Operator:=xlAnd ActiveSheet.PrintOut
Range("Z5").Select ActiveCell.FormulaR1C1 = "B支店" ActiveCell.Characters(2, 2).PhoneticCharacters = "シテン" ActiveWindow.LargeScroll ToRight:=-2 ActiveSheet.Range("$A$5:$E$10000").AutoFilter Field:=3, Criteria1:="=B支店", _ Operator:=xlAnd ActiveSheet.PrintOut End Sub
(yomogi) 2018/02/18(日) 18:59
(マナ) 2018/02/18(日) 19:28
(yomogi) 2018/02/18(日) 20:27
A支店のみ印刷するマクロは
オートフィルタのマクロ と 印刷のマクロ
の組み合わせです。
次の2行でできます。
Range("$A$5:$E$10000").AutoFilter 3, "A支店" ActiveSheet.PrintOut
A支店を印刷後、B支店を印刷するなら
こうなります。
Range("$A$5:$E$10000").AutoFilter 3, "A支店" ActiveSheet.PrintOut Range("$A$5:$E$10000").AutoFilter 3, "B支店" ActiveSheet.PrintOut
C支店も印刷するなら
こうなります。
Range("$A$5:$E$10000").AutoFilter 3, "A支店" ActiveSheet.PrintOut Range("$A$5:$E$10000").AutoFilter 3, "B支店" ActiveSheet.PrintOut Range("$A$5:$E$10000").AutoFilter 3, "C支店" ActiveSheet.PrintOut
(マナ) 2018/02/18(日) 20:51
こんな感じです。
'---
Sub test4()
Range("$A$5:$E$10000").AutoFilter 3, "A支店" ActiveSheet.PrintOut Range("$A$5:$E$10000").AutoFilter 3, "B支店" ActiveSheet.PrintOut Range("$A$5:$E$10000").AutoFilter 3, "C支店" ActiveSheet.PrintOut
End Sub
'---
Sub test5() Dim データ範囲 As Range Dim 抽出列 As Long
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3
データ範囲.AutoFilter 抽出列, "A支店" ActiveSheet.PrintOut データ範囲.AutoFilter 抽出列, "B支店" ActiveSheet.PrintOut データ範囲.AutoFilter 抽出列, "C支店" ActiveSheet.PrintOut
End Sub
'---
Sub test6() Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3
抽出条件 = "A支店" データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
抽出条件 = "B支店" データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
抽出条件 = "C支店" データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
(マナ) 2018/02/18(日) 21:00
Sub test7() Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3
抽出条件 = Range("Z2").Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
抽出条件 = Range("Z3").Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
抽出条件 = Range("Z4").Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut
End Sub
(マナ) 2018/02/18(日) 21:05
Sub test8() Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String Dim i As Long
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3
For i = 2 To 5 抽出条件 = Range("Z" & i).Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut Next
End Sub
ここまで、理解できますか。
(マナ) 2018/02/18(日) 21:15
また、Z列にはC6が表示されています(表のタイトル行は 5列目 です)。
したがって、Z列には同じ支店が表示されてしまいます。
だから、 For i = 2 To 5 となるのですか?
宜しくお願い致します。
(yomogi) 2018/02/18(日) 22:37
はい。別の部品マクロ(最終行を求めるマクロ)を使います。
この部分は、明日以降で。
>したがって、Z列には同じ支店が表示されてしまいます。
この意味がわかりませんが…
重複の削除を実行しても駄目ですか。
'---
コピー貼付けマクロの
Z列にコピーする範囲を間違えていました。
C5も含めてください。
>Range("C6:C10000").Copy Range("Z1") ↓ Range("C5:C10000").Copy Range("Z1")
(マナ) 2018/02/18(日) 22:58
まだまだ先は長そうですが、最後まで完成させたと思います。
引き続き、ご指導宜しくお願い致します。
遅くまでご指導有難うございました。
(yomogi) 2018/02/18(日) 23:59
For i = 2 To 5 の部分は For i = 2 To 6(A〜E支店まであるので)
で良いでしょうか?
(最終的には、この部分はかわるので問題はないとは思いますが)
そして、この構文の 「2〜5行目」の部分を「2〜数値の入っている列番まで」というように変更するのでしょうか?
(yomogi) 2018/02/19(月) 13:12
<加えた構文>
n = Cells(Rows.Count, "Z").End(xlUp).Row ← Z列入っている最後の行位置探し出す構文
For i = 2 To n ← 5からnに変更しました。
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String Dim i As Long
Range("C5:C10000").Copy Range("Z1")
Columns("Z").RemoveDuplicates Columns:=1, Header:=xlYes
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 n = Cells(Rows.Count, "Z").End(xlUp).Row
For i = 2 To n 抽出条件 = Range("Z" & i).Value データ範囲.AutoFilter 抽出列, 抽出条件
Next
End Sub
宜しくお願い致します。
(yomogi) 2018/02/19(月) 13:22
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Long Dim 抽出条件 As String Dim i As Long
Range("C5:C10000").Copy Range("Z1")
Columns("Z").RemoveDuplicates Columns:=1, Header:=xlYes
Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 n = Cells(Rows.Count, "Z").End(xlUp).Row
For i = 2 To n 抽出条件 = Range("Z" & i).Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut Next
End Sub
(yomogi) 2018/02/19(月) 13:25
>ただ一つどうしてもクリアできない部分があり、 >それは各項目の「集計行」まで印刷されてしまう >ことでした。 >今回の資料作成は集計不要のため(集計する項目がない)、 >「集計行」が不要なのです。 >なにか良い方法はないでしょうか?
ならば、キーの数でも数えておいて、
表中のどこかを選択して、
「Ctrlキー」を押しながら、「Shiftキー」も押しながら「:キー」を押してみてください。
表全体が選択できるはずです。
次にマウスで、
ホームタブ→編集の検索と選択→条件を選択してジャンプ→数式→OK
と選択していきます。
集計行には数式が自動で入るのでそれを検索します。
もし、他にも数式があるのなら、空白を検索して行削除したらいいです。
その状態のまま選択されたセルのどれかを右クリックして、
削除→行全体
と選ぶと集計行削除でき、改ページはそのまま残ると思います。
手順が長くなるのでマクロの記録をして、作業の自動化(=マクロの作成)をしたら
より良いかもしれませんね^^
(まっつわん) 2018/02/19(月) 13:59
また、「通番」列には、自動的に採番するように、
=IF(B6="","",SUBTOTAL(3,B$6:B6)) という関数が入っていますので、上手く削除が出来ません。
空白を検索して行削除したらいいです
というのは、フィルタを設定して「空白」抽出してから、その行を削除するということでしょうか?
宜しくお願い申し上げます。
(yomogi) 2018/02/19(月) 16:04
使い方あっています。
完成形に近づいてきました。
次は、この部分です。
>※レイアウト変更により開始データ行(タイトル行)か変わる可能性あり
設定されている、タイトル行と印刷範囲から
データ範囲(A5:E10000)を自動で求めるマクロです。
Sub データ範囲を調べる() Dim r As Long Dim データ範囲 As Range Dim 抽出列 As Long
r = Range(ActiveSheet.PageSetup.PrintTitleRows).Rows.Count Set データ範囲 = Intersect(Range(ActiveSheet.PageSetup.PrintArea), Rows(r & ":10000"))
MsgBox データ範囲.Address
抽出列 = 3
MsgBox データ範囲.Columns(抽出列).Address
End Sub
(マナ) 2018/02/21(水) 21:30
$A$5:$E$10000 ⇒ $A$7:$E$10000 となり、
マクロの列指定の "3" を "2" に変更すると、
$C$5:$C$10000 ⇒ $B$5:$B$10000
と表示に変化があることがわかりました。
データの行は自動で認識してくれると思いますので、行の指定(指示)をするコマンドを作成すれば
良いのでしょうか?
私自身でも少し、いろいろ調べてみたいと思います。
引き続き、ご指導宜しくお願い致します。
(yomogi) 2018/02/22(木) 00:47
>集計する場合、まず「資産所属」ごとに並び変えておかなければならないのでしょうか?
あ、すでに並び替えられている前提と勘違いしてました。
すみません。
集計の前に事前に並び替える必要があります。
数式がデータに含まれるなら、
集計行には空白セルが含まれると思いますのでそれを、
ジャンプ機能で検索します。
通番が上手く行かないなら、一回値に直した方がいいかもです。
全て、コピーを編集するのでいいように加工しちゃいましょう。
(まっつわん) 2018/02/23(金) 08:02
(yomogi) 2018/02/24(土) 18:30
インプットボックスの表示のマクロはわかりましたが、
それを利用して $C$5 の Cの列(3) をどのように結び連れば良いかまでは
たどり着けられませんでした・・・
インプットボックスの表示は以下の様な構文で良いのでしょうか?
ご教示お願い致します。
==============================================
Sub インプットボックスの作成()
Dim buf As String, msg As String msg = "ソートする列番号を指定してください" buf = InputBox(msg)
End Sub
==============================================
(yomogi) 2018/02/24(土) 19:06
http://officetanaka.net/excel/vba/tips/tips37.htm
(マナ) 2018/02/24(土) 20:41
==============================================
Sub インプットボックスの作成2()
Dim buf As Range Set buf = Application.InputBox(Prompt:="ソートする列番号を指定してください。", Type:=8)
End Sub
==============================================
※MsgBox buf.Address(False, False) & "の文字色は" & buf.Font.ColorIndex & "です
の部分は削除してしまいました。まずかったでしょうか?
(yomogi) 2018/02/24(土) 22:15
確かに、そうかもしれません。
以下について、動作確認してみてください。
どちらか好きなほうを、オートフィルタのマクロと組み合わせてみてください。
Sub インプットボックスの作成2() Dim データ範囲 As Range Dim 抽出列 As Long Dim msg As String
Set データ範囲 = Range("A5:E10000")
msg = "ソートする列番号を指定してください"
抽出列 = Application.InputBox(Prompt:=msg, Default:=3, Type:=1)
If 抽出列 < 1 Then Exit Sub If 抽出列 > データ範囲.Columns.Count Then Exit Sub
MsgBox データ範囲.Columns(抽出列).Address & "をソートします" MsgBox 抽出列 & "列目です"
End Sub
Sub インプットボックスの作成3() Dim データ範囲 As Range Dim 抽出列 As Range Dim msg As String
Set データ範囲 = Range("A5:E10000")
msg = "ソートする列をマウスで選択してください"
On Error Resume Next Set 抽出列 = Application.InputBox(Prompt:=msg, _ Default:=データ範囲.Cells(3).Address, Type:=8) On Error GoTo 0 If 抽出列 Is Nothing Then Exit Sub
Set 抽出列 = Intersect(データ範囲, 抽出列.EntireColumn).Columns(1) If 抽出列 Is Nothing Then MsgBox "選択列が間違っています" Exit Sub End If
MsgBox 抽出列.Address & "をソートします" MsgBox 抽出列.Column & "列目です"
End Sub
(マナ) 2018/02/25(日) 10:07
感覚的に操作がしやすようなので、「インプットボックスの作成3」を使用してみたのですが、
組み合わせていざ実行してみましたが(宣言の重複箇所は削除しました)、
延々と処理を続けております(どうやら1万件の処理をしている様子です・・・・(泣)
「3」という数字がたくさん出てきております!!
なんとなくイメージは出来るのですが・・・ どこがマズいのかが理解できません・・・
よろしくお願いいたします。
================================================
Sub マナ先生()
Dim データ範囲 As Range Dim 抽出列 As Range Dim msg As String Set データ範囲 = Range("A5:E10000") msg = "ソートする列をマウスで選択してください" On Error Resume Next Set 抽出列 = Application.InputBox(Prompt:=msg, _ Default:=データ範囲.Cells(3).Address, Type:=8) On Error GoTo 0 If 抽出列 Is Nothing Then Exit Sub Set 抽出列 = Intersect(データ範囲, 抽出列.EntireColumn).Columns(1) If 抽出列 Is Nothing Then MsgBox "選択列が間違っています" Exit Sub End If MsgBox 抽出列.Address & "をソートします" MsgBox 抽出列.Column & "列目です"
Dim 抽出条件 As String Dim i As Long Range("C5:C10000").Copy Range("Z1") Columns("Z").RemoveDuplicates Columns:=1, Header:=xlYes Set データ範囲 = Range("$A$5:$E$10000") 抽出列 = 3 n = Cells(Rows.Count, "Z").End(xlUp).Row For i = 2 To n 抽出条件 = Range("Z" & i).Value データ範囲.AutoFilter 抽出列, 抽出条件 ActiveSheet.PrintOut Next End Sub ================================================ (yomogi) 2018/02/25(日) 21:12
Option Explicit
Sub test9() Dim r As Long Dim データ範囲 As Range Dim 抽出列 As Range Dim msg As String Dim i As Long Dim n As Long Dim 抽出条件 As String
r = Range(ActiveSheet.PageSetup.PrintTitleRows).Rows.Count Set データ範囲 = Intersect(Range(ActiveSheet.PageSetup.PrintArea), Rows(r & ":10000"))
msg = "ソートする列をマウスで選択してください"
On Error Resume Next Set 抽出列 = Application.InputBox(Prompt:=msg, _ Default:=データ範囲.Cells(3).Address, Type:=8) On Error GoTo 0 If 抽出列 Is Nothing Then Exit Sub
Set 抽出列 = Intersect(データ範囲, 抽出列.EntireColumn).Columns(1) If 抽出列 Is Nothing Then MsgBox "選択列が間違っています" Exit Sub End If
抽出列.Copy Range("Z1") Columns("Z").RemoveDuplicates Columns:=1, Header:=xlYes
n = Cells(Rows.Count, "Z").End(xlUp).Row
For i = 2 To n 抽出条件 = Range("Z" & i).Value データ範囲.AutoFilter 抽出列.Column, 抽出条件 ActiveSheet.PrintOut Next
データ範囲.AutoFilter CColumns("Z").Delete
End Sub
(マナ) 2018/02/25(日) 22:16
もう一度、構文をしっかりと復習をして理解してみたいと思います。
いずれは、この程度のマクロ構文は自分簡単に作れるようしっかりと復習したいと思います。
これまでは、教えていただいた構文をただ貼り付けて実行するだけでしたので、
全く成長もなくやってきました。
マナ先生に教えていただいて初めは「どうしてすぐに教えてもらえないのだろう」
「もったいつけつけるなぁ」(失礼しました) と正直思っておりましたが、
今回、お陰様で、初めて「自分でもやってみよう」という気持ちになりました。
多少遠回りになってしまいましたが、マクロの輪郭が少し見えてきたような気がしております。
また、わからないことが出てくれば、この「エクセルの学校」で質問させていただきたいと思います。
だんだん、思考が固くなってくる年代ですが、少し勉強したいと思います。
本当に有難うございました。
ちなみに、
最後の行の、「CColumns("Z").Delete」の箇所は「Columns("Z").Delete」でいいのですよね。
これからも、このニックネームで相談させていただきます。
引き続き、ご指導のほど、よろしくお願いいたします。
(yomogi) 2018/02/27(火) 00:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.