[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『一覧表から条件を指定してプリントアウト』（L.伊藤）
ご指導お願いします。 一覧表から必要条件を抽出してプリントアウトしています。 現在、関数や条件付き書式などを使っていろいろやっていますがデータが 多くなってきたので関数だけでは処理が大変になってきました。 VBAで処理したいと思い、初心者ですが勉強をさせていただきたいのでお願いします。
このような担当者順に並んでいる一覧表があります。 Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ １ 担当ｺｰﾄﾞ 担当 客番号 客名 物件番号 現場名 締め日 完了予定日 ２ R0768 古田 1111 客1 1603882-001 団地８号棟 （31日締め） 2016/08/10 ３ R0768 古田 1111 客1 1604022-001 ビレッジEAST （31日締め） 2016/04/20 ４ R0768 古田 2222 客2 1605103-001 サイトウ様邸 （15日締め） 2016/05/10 ５ R0768 古田 3333 客3 1605108-001 加藤様邸232K （20日締め） 2016/03/27 ６ R0768 古田 4444 客4 1605111-001 千代田1棟7号 （20日締め） 2016/06/15 ７ R2142 高井 2222 客2 1512332-001 松本様邸 （20日締め） 2016/05/20 ８ R2142 高井 4444 客4 1601021-001 住宅新築工事 （31日締め） 2016/05/31 ９ R2142 高井 3333 客3 1602822-001 原新築工事 （31日締め） 2016/05/12 10 k9063 石井 1111 客1 1605056-001 藤井様邸 （31日締め） 2016/05/19 11 k9063 石井 2222 客2 1605076-001 厚木１棟 （20日締め） 2016/02/20 12 k9063 石井 2222 客2 1605157-001 朝日町住宅 （31日締め） 2016/08/01 13 k9063 石井 3333 客3 1605182-001 大沢様邸 （15日締め） 2016/05/08 14 k9063 石井 4444 客4 1605191-001 横浜71号室 （15日締め） 2016/05/20 15 k9063 石井 2222 客2 1605210-001 大岡様邸 （15日締め） 2016/05/15 16 kt722 佐藤 1111 客1 1605231-001 馬場様邸 （31日締め） 2016/10/20 17 kt722 佐藤 2222 客2 1605231-001 馬場様邸 （31日締め） 2016/10/20
新たに印刷条件を他のシートを作り指定したい 締め日は、10日締め・15日締め・20日締め・31日締めの4つなので 入力規則のリストで選択、完了日予定は手入力で指定。 ※もちろん選択リスト表自体は自分で作れます♪ ↓ 締め日 20日締め 完了日予定日１ 2016/05/10 完了日予定日２ 2016/05/19 完了日予定日３ 2016/05/20 印刷ボタン
下のように必要列のみ抽出して担当毎に印刷。 今後は印刷ボタン押下でA4横サイズに12行ずつプリントアウトをしたい。 担当名は枠外表示して表には含めず、指定した締め日・完了予定日は その日付セル部分のみに色を付ける。 （この時の古田着色セルは、5行目完了予定日・６、７行目の締め日です。） ↓↓↓ Ａ Ｂ Ｃ Ｄ Ｅ １ 古田 ２ 客番号 客名 現場名 締め日 完了予定日 ３ 1111 客1 団地８号棟 （31日締め） 2016/08/10 ４ 1111 客1 ビレッジEAST （31日締め） 2016/04/20 ５ 2222 客2 サイトウ様邸 （15日締め） 2016/05/10 ６ 3333 客3 加藤様邸232K （20日締め） 2016/03/27 ７ 4444 客4 千代田1棟7号 （20日締め） 2016/06/15
Ａ Ｂ Ｃ Ｄ Ｅ １ 高井 ２ 2222 客2 松本様邸 （20日締め） 2016/05/20 ３ 4444 客4 住宅新築工事 （31日締め） 2016/05/31 ４ 3333 客3 原新築工事 （31日締め） 2016/05/12
Ａ Ｂ Ｃ Ｄ Ｅ １ 石井 ２ 1111 客1 藤井様邸 （31日締め） 2016/05/19 ３ 2222 客2 厚木１棟 （20日締め） 2016/02/20 ４ 2222 客2 朝日町住宅 （31日締め） 2016/08/01 ５ 3333 客3 大沢様邸 （15日締め） 2016/05/08 ６ 4444 客4 横浜71号室 （15日締め） 2016/05/20 15 2222 客2 大岡様邸 （15日締め） 2016/05/15
Ａ Ｂ Ｃ Ｄ Ｅ １ 佐藤 ２ 1111 客1 馬場様邸 （31日締め） 2016/10/20 ３ 2222 客2 馬場様邸 （31日締め） 2016/10/20
お願いします！！！
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
とりあえず、データ抽出部分だけの処理案です。 以下の操作をマクロ記録すると、ほぼ、そのまま使えるコードが生成されます。 生成されたコードでは印刷対象のシートがアクティブシートになりますので、そこにシート修飾をされたらＯＫです。
最終的には印刷されるわけでしょうから元シートと印刷シートの他に、抽出担当名を指定する条件シートを別に設けます。
●準備
・印刷シートのA1からE1に抽出対象のタイトルを記入。 （客番号 客名 現場名 締め日 完了予定日） ・条件シートのA1 に 担当 といれます。 A2 に抽出したい名前をいれます。 ・印刷シートを選択しておきます
●マクロ記録する操作
１．データタブ、フィルターグルプの詳細設定 ２．リスト範囲(L) に 元シートの A:H 列を指定 ３．検索条件範囲(C) に条件シートのA1:A2 を指定 ４．指定した範囲(O)をチェックして 抽出範囲(T) に 印刷シートの A1:E1 ５．ＯＫボタン
（β） 2016/05/21(土) 12:53
↑ シートを３枚の構成で提案しましたが、印刷シートの印刷範囲を 列指定で設定しておいて、 その印刷範囲の外（左）に 検索項目欄を設け、印刷シートを見ながらマクロ実行させるという手もありますね。 そうしておけば、条件シートは不要になります。
（β） 2016/05/21(土) 19:50
条件シートをなくし、印刷シート上の印刷領域の外に条件指定欄を設定する方向で、色つけも対応する処理をするにあたって 教えてください。
締日条件として 20日締め といった表現をしておられますが、元データでは （20日締め） という記述になっています。 元データが （20日締め） ということですから、入力規則で選ぶリストも （20日締め） というように 設定しておくことは可能ですか？
（β） 2016/05/21(土) 21:14
提示した操作、是非、一度、実際にやって、フィルターオプション機能を体感してみてくださいね。 その操作の流れに色つけ要件も加味してコードにしてみました。
↑でふれましたけど、条件シートは使わず、元シートと印刷シートのみにします。 印刷シートのA1からE1に抽出対象のタイトルを記入。（客番号 客名 現場名 締め日 完了予定日） で、印刷対象領域を、印刷範囲に指定しておいてください。 その印刷領域の右、下記コードでは P.Q.R列を使っています。
P1 : 担当、Q1 : 締め日、R1 : 完了予定日 の各タイトルを入れておきます。 で、担当、締め日、完了予定日 すべて、2行目から下に、いくつでも必要なだけ、入力します。
★なお、締め日の入力規則リストの文字列は元シートのG列の文字列と同じものにしておいてください。
Sub Sample()
Dim shO As Worksheet
Dim shP As Worksheet
Dim c As Range
Set shO = Sheets("Sheet1") '元シート
Set shP = Sheets("Sheet2") '印刷シート
shP.Columns("A:E").Interior.ColorIndex = xlNone
'データ抽出
shO.Columns("A:H").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=shP.Range("P1", shP.Range("P" & Rows.Count).End(xlUp)), CopyToRange:=shP.Range("A1:E1"), Unique:=False
'抽出データの締日、完了予定日の色付け処理
If shP.Range("A1").CurrentRegion.Rows.Count > 1 Then
Coloring shP, shP.Range("Q1", shP.Range("Q" & Rows.Count).End(xlUp)), "D"
Coloring shP, shP.Range("R1", shP.Range("R" & Rows.Count).End(xlUp)), "E"
End If
shP.PrintOut
End Sub
Private Sub Coloring(shP As Worksheet, cr As Range, col As String)
Dim c As Range
shP.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=cr, Unique:=False
With shP.Range("A1").CurrentRegion.Columns(1)
If .SpecialCells(xlCellTypeVisible).Count > 1 Then
For Each c In .Cells.Resize(.Rows.Count - 1).Offset(1)
If Not c.EntireRow.Hidden Then c.EntireRow.Cells(1, col).Interior.Color = vbYellow
Next
End If
On Error Resume Next
shP.ShowAllData
On Error GoTo 0
End With
End Sub
（β） 2016/05/21(土) 22:21
まずは、データ抽出のマクロきちんとできました。 設定方法も条件指定内容も順を追っていけたのでよくわかりました♪
次の条件シートをなくす方法に取り掛かっています。 で・・・早速つまづいています。 初歩的なことだと思うのですが「印刷対象領域を、印刷範囲に指定」がわかりません・・・ それと、「2行目から下に、いくつでも必要なだけ、入力します。」は、想定される担当や 完了日をすべて入力するという事でしょうか？ もしそうであれば、担当者は不特定多数で、施工完了日は予想出来ません。
せっかく提示しくださったVBAが理解できていないためにつまづいている状況だと思います＞＜ （L.伊藤） 2016/05/22(日) 09:29
まず、コードの前に、印刷シートの設定の件。
・指定担当者等、条件欄を印刷シートに配置しますので、そのまま印刷すると、これら条件欄も印刷されてしまいますね。 むしろ、そうしたいということなのかもしれませんが、以下は、条件欄は印刷せず、 抽出データのみを印刷したいということを前提にしています。 ・通常の2013で、エクセルを立ち上げ、印刷設定で A4横を指定すると、横 N列までが1ページになるかと思います。 実際のデータは列幅も、それぞれ異なるでしょうから、それとは異なる列になるでしょうけど、今回の場合、 印刷したいのは A～E列だと思いますので、A:E列を選択してページレイアウトタブの印刷範囲-->印刷範囲の設定(S)をクリック。 これで、F列から右にどんなものが記述されていようと印刷対象外になります。 ・あわせて、印刷タイトルをクリックし、ダイアログ内のタイトル行(R)に１行目を指定しておきます。 ・難問は、１ページ１２行（タイトル含めれば１３行）で印刷したいというところでしょうね。 『エクセル 印刷行数の指定』あたりで検索すると、余白 または 行の高さ による調整設定の手順の解説ページが いろいろ出てきます。行の高さは、ちょっと変更するとみっともなくなる可能性があるので余白調整でしょうか。 これが面倒だということなら、マクロ内で、データ１２行毎に強制的に改ページをいれることもできますが。
次に締め日と完了予定日の件。
抽出は、あくまで指定の担当者のみで行います。 抽出されたもののうち、指定の締め日のもの、あるいは指定の完了予定日のものを、それぞれのセルに色つけですよね。 ですから、その、色を付けたい 締め日 あるいは 完了予定日 を指定します。 （アップされた例では 締め日が 20日締め、完了予定日が 2016/5/10、2016/5/19、2016/5/20 の ３つでしたね）
アップされた例では 締日が１つ、完了予定日が 1～3 までの 3つまで となっていましたが、提案しているのは 必要なら、色つけの締め日や完了予定日をいくつでも指定できるようにしましょうということです。 もちろん、締め日を１つだけ指定すれば、その締め日だけに色つけということになりますし、完了予定日を１０個指定すれば その１０個に色付けします。
で、抽出担当者ですけど、これも『必要なら』何人でも指定できますよということです。 もちろん、一人だけ指定すれば、その人のデータのみが抽出されます。
これらを実現するために
>>P1 : 担当、Q1 : 締め日、R1 : 完了予定日 の各タイトルを入れておきます。 >>で、担当、締め日、完了予定日 すべて、2行目から下に、いくつでも必要なだけ、入力します。
とコメントしました。
（β） 2016/05/22(日) 11:54
元のデータ一覧はほかの部署で作成するデータなのです。 担当者と完了日の件ですが、完了日は365日1年間の日付すべてを入力すれば問題ないと思います。 担当者は、毎回誰が登録されるか分かりません。 なので、担当者を指定するのは難しいです… ；_； （L.伊藤） 2016/05/22(日) 16:32
説明がわるかったようですね。
マクロ内では、担当者も 色つけようの締め日も完了予定日も 一切、指定はしません。
あくまで、操作者が、印刷シート上の、条件欄（担当者欄や締め日欄や完了予定日欄）に必要な情報を入力した後 マクロ実行します。 (要件を誤解してますかね？ 質問文から、操作者が条件を入力、その条件をマクロが読み取って処理するんだと思っているんですが）
（β） 2016/05/22(日) 17:07
すいません！ 明日の夜まで検証ができない状態なのですが、取り急ぎ返信しています。 たぶん私が理解していなくて、会話が行違っているのかもしれないのですが・・・・・・ 入力する条件は 「締め日」と「完了予定日」の二つです。 担当者は一覧データに入力されている全員が対象です。 担当者はその都度いろんな名前の人が追加されたり削除されたりします。 （例えば知らない間に、福山さんが追加されたり古田さんが削除されたり・・・） 指定する名前が特定できないのです。 また、極端に言えば、印刷さえできればいいので担当者ごとのシート作成はいらないかもしれません。
（L.伊藤） 2016/05/22(日) 21:02
>>担当者は一覧データに入力されている全員が対象です。
あぁ、そうだったんですか。 で、担当者ごとにシートをわけることもできますし、同じシートに、とにかく指定された必要な列のみを表示することもできます。 どちらにされますか？
また、同じシートであれ、別シートであれ、担当者の名前は必要ですか？あるいは不要ですか？ （アップされた例では先頭に 担当者の名前がありますね）
同じシートの場合、担当ごとにページ替えが必要ですか？不要ですか？
いずれにしても、操作者が指定するものは「締め日」と「完了予定日」の二つということは了解しました。
（β） 2016/05/22(日) 21:08
ありがとうございます！ 今回は別シートにしなくても良いです。 担当者名は必要です。 プリントアウトは担当者ごとに改ページをしたいです。 お願いします。 （L.伊藤） 2016/05/23(月) 06:27
それでは Sample を入れ替えです。Coloringプロシジャは変更有りません。 (アップ後、ちょこっと修正しました。 7:53)
なお、勝手ながら以下の仕様にしました。
１．元シート、条件シート、印刷シートの３シート構成。 ２．印刷シート、1行目のA列～E列に 抽出タイトルを記入しておいてください。 ３．印刷シートに条件欄を取り除きましたので、印刷範囲設定は不要です。 ４．印刷シートの F,G列を作業列に使っています。（マクロ内で生成し、作業後、マクロ内でクリア） ５．勝手ながら、担当者ですが、アップされたサンプルでは、最初の担当のみ、タイトル行の上に表示されていますが タイトル行の下（つまり２行目）にしました。 ４．条件シート、A1 に 締め日、B1 に完了予定日 タイトル。（アップ済みのものは 印刷シートの Q列、R列でした） A2 に色つけしたい締め日、B2から下に色つけしたい完了予定日を指定します。
これは、そちらの要件次第ですが、印刷シートに、１行目を行タイトルとして設定しておいたほうがいいと思います。
Sub Sample()
Dim shO As Worksheet
Dim shP As Worksheet
Dim shC As Worksheet
Dim c As Range
Dim r As Range
Dim x As Long
Application.ScreenUpdating = False
Set shO = Sheets("Sheet1") '元シート
Set shP = Sheets("Sheet2") '印刷シート
Set shC = Sheets("Sheet3") '条件シート
'印刷シート初期化
With shP
.ResetAllPageBreaks
.Columns("D:E").Interior.ColorIndex = xlNone
.Range("A1").CurrentRegion.Offset(1).ClearContents
.Range("F1").Value = shO.Range("B1").Value
End With
'データ抽出
shO.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=shP.Range("A1:F1"), Unique:=False
'担当別処理
With shP.Range("A1").CurrentRegion
With .Columns("G").Resize(.Rows.Count - 1).Offset(1)
.Formula = "=IF(F2<>F1,1,"""")"
Set r = .SpecialCells(xlCellTypeFormulas, xlNumbers)
r.EntireRow.Insert
For Each c In r
x = x + 1
With c.Offset(-1).EntireRow
.Range("A1").Value = .Range("F2").Value '担当名
If x <> 1 Then shP.HPageBreaks.Add Before:=.Cells
End With
Next
End With
.Columns("F:G").Clear
End With
'抽出データの締日、完了予定日の色付け処理
If shP.Range("A1").CurrentRegion.Rows.Count > 1 Then
Coloring shP, shC.Range("A1", shC.Range("A" & Rows.Count).End(xlUp)), "D"
Coloring shP, shC.Range("B1", shC.Range("B" & Rows.Count).End(xlUp)), "E"
End If
shP.PrintOut
End Sub
（β） 2016/05/23(月) 07:49
やっと取り掛かりました！ が・・・早速エラーが出ています＞＜ 「コンパイルエラー Sub またはFunctionが定義されていません」となって 下から5行目の「Coloring」に色が着いています。 なにかこちらで定義付けをしないといけないのでしょうか？ （L.伊藤） 2016/05/24(火) 23:35
最初にアップしたように、今回のコードは メインプロシジャ Sample と、その中で使う サブプロシジャ Coloring で構成されます。
Sample は β） 2016/05/23(月) 07:49 でアップしたものでいれかえですが、アップ時コメントした通り Coloring は、そのまま使いますので、（β） 2016/05/21(土) 22:21 でアップしたものを記述したままに しておいてください。
標準モジュールのイメージは
Sub Sample() ’ ’ ’ ’ End SUb
Private Sub Coloring(shP As Worksheet, cr As Range, col As String) ’ ’ ’ ’ End Sub
このようになります。
（β） 2016/05/25(水) 00:42
なるほど！抽出とカラーリングで分かれている構造なのですね！！
思い通りのものが出来そうなのですが、締め日のデータにスペースが入っていたり、いなかったりまちまちでした。 ズバリではなく含む条件での着色はどこをいじればよいのでしょうか？ （L.伊藤） 2016/05/25(水) 22:35
第一義としては、データマッチング処理ですから、各担当者にも理解を得たうえで データの中の締日そのものを決められた形式でいれてもらう。これが本線です。 たとえばデータ内の締日欄にも入力規則を設定するぐらいのことをやるべきかと。
まぁ、これが正論ですが、諸般の事情で、そんなわけにもいかないということなら 条件欄設定の締日リストの内容を *20日締め* のように前後に * を付加したものにしてください。 あるいは 20日 と 締め の間にスペースがあるデータも救いたいということなら *20日* とか *15日* といったように。 もし、将来 5日締め なんてのが登場すると *5日 の場合、 25日や15日も含まれるので具合悪いですけど、そういったものは将来的にないという前提で。
（β） 2016/05/25(水) 23:53
いろいろありがとうございます。 締め日は * で対応して解決しました♪
今度は完了予定日列がタイトル行を除いてすべて着色されてしまいました。 もぉ・・・・私には無理なのでしょうか・・・＞＜； いろいろいじってみてますが分かりませんでした。 （L.伊藤） 2016/05/27(金) 00:18
>>私には無理なのでしょうか・
そんなことはないですよ。ゴールは目の前です。
こちらで、条件シートのB列を以下にすると、そちらと同じく、すべての完了予定日に色がつきます。
完了予定日 2016/5/10 2016/5/19 2016/5/20 空白 空白 何かの値（スペース あるいは ゴミ）
この場合、フィルターオプションは、2行目から7行目までを指定条件だと認識します。 そうすると 空白 も指定条件になります。空白 というのは フィルターオプションから見ると『すべて』という条件になります。
おそらく、B列のずっと下のほうに何か（おそらく目に見えないスペース）が入っているのではないでしょうか。
一度、B列を選択して Deleteキーでクリアし、改めて 1行目のタイトル含めて記入しなおして実行してみてください。
または、いまのままでも、
Coloring shP, shC.Range("B1", shC.Range("B" & Rows.Count).End(xlUp)), "E"
これを
Coloring shP, shC.Range("B1", shC.Range("B1").End(xlDown)), "E"
にしてもＯＫになるとは思います。
で、この推測が当たっていれば、A列でも同じことがいえます。 現在、コードとしては締め日も複数指定可能にしています。もし、絶対に１つしか指定しないということであれば
Coloring shP, shC.Range("A1", shC.Range("A" & Rows.Count).End(xlUp)), "D"
これを
Coloring shP, shC.Range("A1:A2"), "D"
にしておいたほうが安全かもしれません。
（β） 2016/05/27(金) 08:00
β様！ 長いことお付き合いいただきありがとうございます！ 条件指定の見出しの文字が元データと違っていたために着色がうまくいかなったようです。
結局、抽出する列等はじめのモノと少し構成を変えて作成しましたがきちんと動いてくれています！！ 感動しますね♪
最後に印刷範囲について教えてください。；_； 最終的にＩ列まで抽出範囲が増えました。 現在、行方向は高さをあらかじめ設定しておけばマクロを何度起動してもクリアにならないのですが、 列方向はＧ列で改ページされてしまいます。 列方向も1ページに収まるように固定出来ますか？ （L.伊藤） 2016/05/28(土) 21:13
たとえば ページ設定のページタブの中に
次のページに合わせて印刷(F) 横 x 縦 というところがありますね この 横を 1 、縦を空白に設定しておけばどうなりますか？
（β） 2016/05/28(土) 21:25
β様 こんな初歩的な方法で解決するなんて・・・ お恥ずかしい限りです。
今から、しっかり理解できるよう見直します！ 本当にありがとうございました♪ （L.伊藤） 2016/05/28(土) 22:21
ス、スミマセン・・・ 印刷範囲なのですが、５２ページまでしかデータがないのに、８３ページまで印刷されることになっています。 ５３ページ目からは罫線のみが印刷される状態です。 スペースとか確認しましたが無いみたいなんです；；
（L.伊藤） 2016/05/29(日) 10:42
罫線のみでもエクセルから見れば、ちゃんとした印刷対象物です。 空白のシートに罫線のみセットしたものを印刷すると、『データ』がなくても印刷されますよね。
shP.PrintOut の前に
shp.PageSetup.PrintArea = shp.Range("A1", shp.Range("A" & Rows.Count).End(xlUp)).EntireRow.Address
これを記述し、印刷範囲を設定するとどうなりますか？
（β） 2016/05/29(日) 14:40
あるいは今回のシートレイアウトであれば
shp.PageSetup.PrintArea = shp.Range("A1").CurrentRegion.EntireRow.Address
shP.PrintOut
でもよさそうですし、直接
shp.Range("A1").CurrentRegion.PrintOut
だけでもいいかと思います。
（β） 2016/05/30(月) 07:06
すみません。 また、問題が発生です・・・ と、その前に解決のお礼をしたと思っていたのですが、UPされていないかったみたいです＞＜ その節はありがとうございました！！！！！ 大変重宝しています♪
さて・・・しばらく問題なく使っていたのですが、着色が出来なくなってしまいました。 データが1行しかない人が出てきてしまい、その人のあとのデータで セルの着色がまったく機能してくれなくなったように思います。 （違っていたらごめんなさい） 着色が出来るような解決策をご教示ください。 （L.伊藤） 2016/06/14(火) 23:03
まず、そちらで使っている、現在のコードを、そのまま コピペでアップしてください。 (いくつか、変更レスをしていますので、最終的に、どのようなコードになっているかを確認したいので）
（β） 2016/06/15(水) 07:14
とりあえず （β） 2016/05/23(月) 07:49 でアップしたベースで以下。 Coloring は、そのまま使います。 なお、その後レスした印刷範囲の調整等々は未反映です。（最終的に、どうされたかわかりませんので）
Sub Sample()
Dim shO As Worksheet
Dim shP As Worksheet
Dim shC As Worksheet
Dim c As Range
Dim r As Range
Dim x As Long
Application.ScreenUpdating = False
Set shO = Sheets("Sheet1") '元シート
Set shP = Sheets("Sheet2") '印刷シート
Set shC = Sheets("Sheet3") '条件シート
'印刷シート初期化
With shP
.ResetAllPageBreaks
.Columns("D:E").Interior.ColorIndex = xlNone
.Range("A1").CurrentRegion.Offset(1).ClearContents
.Range("F1").Value = shO.Range("B1").Value
End With
'データ抽出
shO.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=shP.Range("A1:F1"), Unique:=False
'担当別処理
With shP.Range("A1").CurrentRegion
With .Columns("G").Resize(.Rows.Count - 1).Offset(1)
For x = .Rows.Count To 2 Step -1
Set c = Rows(x).Columns("F")
If c.Value <> c.Offset(-1).Value Then
c.EntireRow.Insert
c.Offset(-1).EntireRow.Range("A1").Value = c.Value '担当者名
If x <> 2 Then shP.HPageBreaks.Add Before:=c.Offset(-1)
End If
Next
End With
.Columns("F:G").Clear
End With
'抽出データの締日、完了予定日の色付け処理
If shP.Range("A1").CurrentRegion.Rows.Count > 1 Then
Coloring shP, shC.Range("A1", shC.Range("A" & Rows.Count).End(xlUp)), "D"
Coloring shP, shC.Range("B1", shC.Range("B" & Rows.Count).End(xlUp)), "E"
End If
shP.PrintOut
End Sub
（β） 2016/06/15(水) 08:31
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.