[[20180127162134]] 『項目毎に印刷を連続して行いたいのです』(yomogi) ページの最後に飛ぶ

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

 

『項目毎に印刷を連続して行いたいのです』(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 >


追加のお願いです。
印刷された各帳票の「通番」はすべて連番表示されるようにしたいと思います。
宜しくお願い致します。
(yomogi) 2018/01/27(土) 17:16

レイアウト変更もありうるなら

1)application.inputboxで支店名の列を選択し
2)「重複の削除」で支店名リストを作成し
3)リストから支店名を1つずつ取り出し
4)オートフィルターを実行・印刷

(マナ) 2018/01/27(土) 18:45


ひとつひとつオートフィルタ実行して印刷する作業が時間がかかるのです。
リスト選択(支店数)が100以上もあるので、ずっと繰り返し作業を行うことを効率化したいのです(一気に印刷がミソなのです・・・)。
また、オートフィルターを実行すると、番号(連番)が固定値となるため連番表示とならないのです。
やっぱり、こんな都合のよいマクロは難しいですね。
(yomogi) 2018/01/27(土) 22:58

わたしの提案は、手作業ですることではなく、
マクロで実行する場合の流れを示したものです。
連番は、A列を関数にしておけばよいです。Subtotal関数を使います。

(マナ) 2018/01/27(土) 23:27


そうですか。私はてっきり、
1)一旦、データを目的項目ごとにシート分割をして
2)分割されたシートをそれぞれ順番に印刷したあと
3)元データのシート以外を削除するものだと思っておりました。

なるほどです。

ちなみに私はマクロプログラム作成は未経験者ですので、
一つ一つ教示ください。

>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


どんなマクロを作ろうとしているかイメージしていただくために
まずは、手作業で実行してみてください。
全支店について実行する必要はありません。
例えばA支店について実行できることを確認してみてください。

・1〜6行目をタイトル行に設定
・A列で可視行に連番になるように数式を設定

そのうえで、

・A支店でフィルター実行
・印刷

これで希望の結果が得られるなら
マクロで、全支店について繰り返せばよいのです。

(マナ) 2018/01/28(日) 10:27


連番については、↓を参考にするとよいです。
http://www.relief.jp/docs/000439.html

(マナ) 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


1)タイトル行設定と数式設定は手作業で1回実行で十分です。(マクロ不要)
2)Subtotalの式は、リンク先の最後にある対策が必要です。
3)またデータが増えても対応できるように多めに設定しておくとよいです。

念のため確認です。
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


ここで、"$A$5:$E$53"は、データの範囲で変動します。
こういうのを 変数 を使うとマクロらしくなります。
こんな感じです。

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)書式(枠線・セル幅・フォント・印刷範囲 等)を引き継ぎたい。

ということだから、数式も予め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

>Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

「値貼付け」していますが、何か理由はありますか。

(マナ) 2018/02/02(金) 23:15


マナ様
お世話になります。
値貼り付けは特に理由はありませんでした。
枠線がすでに引いてあったので、値貼り付けの方がいいかなと思った程度です。
この行をすべて削除するのでしょうか?
よろしくお願いします。
(yomogi) 2018/02/02(金) 23:55

おくればせながら、、、

印刷だけですよね?
集計機能を使えば
支店ごとに改ページも入れられますよ?

手動でしても大した作業量ではないとおもいますが、
「だれでも、間違いなく確実に」ということならマクロ化も有効でしょう。
マクロの記録からしてみては?

流れ的には、

シートを新しいブックにコピー
並び替え(支店毎等)
集計(小計行が不要ならクリアする。ジャンプ機能で数式のある行か空白のある行を検索)
印刷(タイトル行の設定をする。事前にしてあれば不要)
新しいブックを保存せずに閉じる

というような感じで実現できそうですが。。。
(まっつわん) 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


マナ様
前回、最終的に作成したマクロでは、先にオートフィルタで「A支店」を選択した後で
重複チェックをする構文になっていましたので、出来上がりのZ列にはいつも「A支店」しか
表示されていませんでした。

したがいまして、少し修正したのですが、いかがでしょうか?
よろしくお願いいたします。

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


復習です。
ここまで4つの部品マクロがでてきました。

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


組み合わせの例です。
Z列に、支店のリストを作成するマクロは、
まず、全データをZ列にコピペしたあと
重複の削除を実行すればよいです。

 Range("C6:C10000").Copy Range("Z1")
 Columns("Z").RemoveDuplicates Columns:=1, Header:= xlYes

このZ列のデータを使ってオートフィルタ、印刷を繰り返せば
目的の作業が実現できます。
ここまで理解できますか。

(マナ) 2018/02/18(日) 11:08


マナ様
有難うございます。
Z列のデータを使って、オートフィルタ、印刷をくりかえしたらこんなに長くなってしまいました。
でも肝心な
繰り返しのマクロは、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


午前中の説明でわからないことはありますか。
4つの部品マクロは理解できましたか。

(マナ) 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


↑の方法は、支店数が多くなるとマクロがどんどん長くなります。
同じことを、何回も記述するのも、なんとかしたいですよね。
そこで、変数や、For〜Nextを使います。

こんな感じです。

'---

 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


Z列のセルにある支店名を抽出条件にするならこうです。

 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


これをFor〜Nextを使うと、こうなります。
test7とtest8を見較べてください。

 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


マナ様
有難うございます。
何とか理解できました。
今は i = 変数? が 2(列目)から5(列目)と結果がわかっているので、
Z列は何種類あるかがわからないので、これを解決しないといけないのですね?

また、Z列にはC6が表示されています(表のタイトル行は 5列目 です)。
したがって、Z列には同じ支店が表示されてしまいます。

だから、 For i = 2 To 5 となるのですか?

宜しくお願い致します。

(yomogi) 2018/02/18(日) 22:37


>Z列は何種類あるかがわからないので、これを解決しないといけないのですね?

はい。別の部品マクロ(最終行を求めるマクロ)を使います。
この部分は、明日以降で。

>したがって、Z列には同じ支店が表示されてしまいます。

この意味がわかりませんが…
重複の削除を実行しても駄目ですか。

'---

コピー貼付けマクロの
Z列にコピーする範囲を間違えていました。
C5も含めてください。

 >Range("C6:C10000").Copy Range("Z1")
          ↓
  Range("C5:C10000").Copy Range("Z1")

(マナ) 2018/02/18(日) 22:58


マナ様
わかりにくい説明で申し訳ありませんでした。
C6 ⇒ C5 にすることで、解決できました。

まだまだ先は長そうですが、最後まで完成させたと思います。
引き続き、ご指導宜しくお願い致します。

遅くまでご指導有難うございました。
(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


マナ様
お世話になります。
先程、あちこちネットで調べていて、上記の通り「2〜数値の入っている列番まで」ということであれば、
以下の構文を見つけました。
いかがでしょうか?それとももっと違う考え方があるのでしょうか?
宜しくお願い申し上げます。

<加えた構文>

  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


マナ先生
「ActiveSheet.PrintOut」が抜けていましたので、修正しました。

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


>Z列入っている最後の行位置探し出す構文

使い方あっています。
完成形に近づいてきました。

次は、この部分です。

>※レイアウト変更により開始データ行(タイトル行)か変わる可能性あり

設定されている、タイトル行と印刷範囲から
データ範囲(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


マナ様
いつもありがとうございます。
早速、教えていただいた構文を単体で実行してみました。
まだまだ、構文の意味ははっきりと理解は出来ていませんが(これからいろいろ調べてみるつもです)、
タイトル行を2行挿入すると(タイトル位置が今より2行下がっていたとすると)実行後にポップアップ
されるウィンドウに記載されているデータ範囲が、

 $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


それでもよいのですが、
Application.InputBox のほうが良いと思います。
数字だけを入力可能にできたり、
マウスで列を指定したりできます。

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.