Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1530 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【73747】複数ソートして別々に印刷 nonoka 13/2/8(金) 11:28 質問[未読]
【73750】Re:複数ソートして別々に印刷 UO3 13/2/8(金) 12:36 発言[未読]
【73752】Re:複数ソートして別々に印刷 nonoka 13/2/8(金) 15:13 回答[未読]
【73753】Re:複数ソートして別々に印刷 nonoka 13/2/8(金) 16:14 回答[未読]
【73754】Re:複数ソートして別々に印刷 UO3 13/2/8(金) 20:00 発言[未読]
【73755】Re:複数ソートして別々に印刷 UO3 13/2/8(金) 20:02 発言[未読]
【73796】Re:複数ソートして別々に印刷 nonoka 13/2/15(金) 22:50 回答[未読]
【73798】Re:複数ソートして別々に印刷 UO3 13/2/16(土) 5:12 発言[未読]
【73805】Re:複数ソートして別々に印刷 nonoka 13/2/16(土) 20:47 回答[未読]
【73807】Re:複数ソートして別々に印刷 UO3 13/2/16(土) 22:27 発言[未読]
【73819】Re:複数ソートして別々に印刷 nonoka 13/2/17(日) 15:37 質問[未読]
【73820】Re:複数ソートして別々に印刷 UO3 13/2/17(日) 16:14 発言[未読]
【73821】Re:複数ソートして別々に印刷 nonoka 13/2/17(日) 16:29 回答[未読]
【73823】Re:複数ソートして別々に印刷 UO3 13/2/17(日) 17:31 発言[未読]
【73824】Re:複数ソートして別々に印刷 nonoka 13/2/17(日) 17:54 回答[未読]
【73826】Re:複数ソートして別々に印刷 UO3 13/2/18(月) 9:45 発言[未読]
【73827】Re:複数ソートして別々に印刷 nonoka 13/2/18(月) 10:32 お礼[未読]
【73747】複数ソートして別々に印刷
質問  nonoka  - 13/2/8(金) 11:28 -
引用なし
パスワード
   いつもお世話になっております。


Ａ列〜Ｍ列　８、９行目に見出し１０行目から下にデータがあります。
現在、オートフィルタを使用して、Ｌ列で項目を選んで同じものを表示させて
印刷を行っています。

例えば
Ｌ列
Ａ
Ｂ
Ａ
Ｃ
Ｄ
Ｄ

とあれば、
マクロを実行するとＡだけの列を印刷、Ｂだけの列を印刷、Ｃ，Ｄも同様と言うように、オートフィルタでわざわざ選ばなくてもすべて、別々に印刷することが出来ないでしょうか？

宜しくお願い申し上げます。
【73750】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/8(金) 12:36 -
引用なし
パスワード
   ▼nonoka さん：

こんにちは

実際のフィルタリングのタイトル行は　９　行目ですね。
（つまり　９行目に　▼　がある状態ですね。）

で、Ｌ列にあるコードの種類だけ自動的に印刷ということですね。
現在オートフィルターが設定されていると思いますので、それを活かし
フィルターオプションをかますのはいかがでしょう。

１．作業用のからっぽの別シートを用意します。（最終的には非表示でも構いません）
２．フィルターオプションで、Ｌ９から始まるＬ列の領域を選択して、重複を無視して
　作業用シートのＡ列に、Ｌ列一意の値を抽出します。
３．あとは作業用シートのＡ２〜Ａ○までの値をループで取り出し、その値で元シートの
　Ｌ列をオートフィルターで絞り込み。
　ここについては、とりあえず固定値でフィルタリングしましょう。
４．抽出された状態で印刷します。

この中で　３．のループ処理以外は操作を行いマクロ記録すればコードが生成されます。

あとは。３．のループコードを書き、そこで取得した値を　３．で固定で抽出する操作で
生成されるコードの抽出条件に変数で与えるということになります。

まず、ここまで、やってみられてはいかがでしょう。
【73752】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/8(金) 15:13 -
引用なし
パスワード
   ▼UO3 さん：
了解しました。やってみます。
【73753】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/8(金) 16:14 -
引用なし
パスワード
   ▼UO3 さん：

こんな感じでしょうか？

Sub プリント()

　　Range("L9").Select

　　Range("L9:L2000").AdvancedFilter Action:=xlFilterInPlace, Unique:=True　　'一意の値抽出してprintへｺﾋﾟｰ
　　Range("L10:L2000").Select
　　Selection.Copy
　　Sheets("print").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　　　　:=False, Transpose:=False
　　Sheets("Schedule").Select
　　Application.CutCopyMode = False
　　ActiveSheet.ShowAllData
　　
　　ActiveSheet.Range("$A$9:$M$2000").AutoFilter Field:=12, Criteria1:="FS"　　'選択
　　ActiveWindow.SmallScroll Down:=-3
　　
　　ActiveSheet.PrintPreview　　'プリントプレビュー表示
　　
　　ActiveSheet.Range("$A$9:$M$2000").AutoFilter Field:=12　　'フィルター解除
　　Range("A1").Select
　　
　　Sheets("print").Select　　　'コピーしたデータを削除
　　Range("A1:A14").Select
　　Selection.ClearContents
　　Range("A1").Select
　　Sheets("Schedule").Select
　　Range("A1").Select
　　　　
End Sub
【73754】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/8(金) 20:00 -
引用なし
パスワード
   ▼nonoka さん：

こんばんは

申し上げた手順そのものが少し間違っていました。
（そちらの操作も、申し上げた手順とは、少し違っていたようですが）

作業用シートを準備するのはやめ、printシートの O列を作業列に使います。

Sub Sample()
　　Const wCol As String = "O"　'"print" シート上の作業列
　　Dim shTo As Worksheet
　　Dim c As Range
　　Dim r As Range
　　Dim a As Range
　　
　　Application.ScreenUpdating = False
　　
　　Set shTo = Sheets("print")
　　shTo.Cells.ClearContents
　　
　　With Sheets("Schedule")
　　　　Set a = .Range("A9:M2000")　　　'リスト領域
　　　　.AutoFilterMode = False　　 'オートフィルターがかかっていた場合もいったん解除
　　　　
　　　　a.Columns("L").AdvancedFilter Action:=xlFilterCopy, _
　　　　　　　　　　　　　　　　　　CopyToRange:=shTo.Range(wCol & 1), Unique:=True
　　　　shTo.Columns(wCol).Hidden = True
　　　　Set r = shTo.Range(wCol & 1).CurrentRegion
　　　　a.AutoFilter　　　　　　　　'あらためてオートフィルターセット
　　　　
　　　　For Each c In r.Offset(1).Resize(r.Count - 1)
　　　　　　a.AutoFilter Field:=12, Criteria1:=c.Value
　　　　　　.Range("A1", a).Copy shTo.Range("A1")
　　　　　　shTo.PrintOut 'Preview　　　 '最終的には PrintOut に変更
　　　　Next
　　　　
　　　　.AutoFilterMode = False
　　　　
　　End With
　　
　　shTo.Cells.ClearContents
　　Application.ScreenUpdating = True
　　
End Sub
【73755】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/8(金) 20:02 -
引用なし
パスワード
   ▼nonoka さん：

もう１つ。
実行前にScheduleシートにオートフィルターを設定しておく必要がありません。
（設定してあってもいいですが）
【73796】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/15(金) 22:50 -
引用なし
パスワード
   ▼UO3 さん：
▼UO3 さん：
こんばんは。
返信遅くなって申し訳ありません。海外出張に出ておりまして…。
あれから、ご教授頂いたコードで試しましたが、
ソート出来ている場合と出来ていないところがありました。
色々検証してみましたが、わかりませんでした。

例えばＬ列を検索して、OGを検索して一致した行だけOGプリントシートに文字列コピーする。あと複数ある項目はその分シートを作りそれぞれのシートにコピーして、印刷後にコピーした部分を消去。と言うのはどうでしょうか？
予めプリント用のテンプレートを作っておく方法です。可能でしょうか？
【73798】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/16(土) 5:12 -
引用なし
パスワード
   ▼nonoka さん：

おはようございます

>ソート出来ている場合と出来ていないところがありました。

ソートとおっしゃるのは、印刷の順序としてＬ列の値の昇順で印刷したいということでしょうか？
テーマでは「複数ソートして」と明記しておられたのですが、アップしたコードでは
ソートをしていません。
「ソート」という意味が、同じコードをまとめるという意味だと思いましたので。

もし、印刷順をＬ列の値の昇順ということなら

shTo.Columns(wCol).Hidden = True

この上でも下でもよろしいのですが以下のコードを追加してお試しください。

shTo.Columns(wCol).Sort Key1:=shTo.Columns(wCol), Order1:=xlAscending, Header:=xlYes
【73805】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/16(土) 20:47 -
引用なし
パスワード
   ▼UO3 さん：
同じものを集めて印刷するという意味です。
違うものが集まった印刷結果が一部出力されました。
昇順などは必要ありません。
【73807】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/16(土) 22:27 -
引用なし
パスワード
   ▼nonoka さん：

>違うものが集まった印刷結果が一部出力されました。

う〜ん・・・
指定の値でオートフィルターをかけて、それを印刷しているだけですから
指定の値以外のものが抽出されてそこに存在すると言うことは考えられないのですが・・

具体的に、どんな指定の値の時に、それ以外のどんな値が混在していましたか？
【73819】Re:複数ソートして別々に印刷
質問  nonoka  - 13/2/17(日) 15:37 -
引用なし
パスワード
   ▼UO3 さん：

OG
RX
PS

などのコードがあるとします。

順番にオートフィルターでOG、RX、PSでプリントした際、
RXがｵｰﾄﾌｨﾙﾀｰの選択ﾎﾞｯｸｽになかった場合はどのようなコードを入れればいいでしょうか？
【73820】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/17(日) 16:14 -
引用なし
パスワード
   ▼nonoka さん：

こんにちは

もしかしたら誤解があるのかも？

私のコードは、
Ｌ列に存在するコードで、Ｌ列を順番にフィルタリングして印刷しています。
オートフィルター設定も、フィルタリングも、最後のオートフィルター解除もすべて
ＶＢＡ内で行っています。

ですから

>順番にオートフィルターでOG、RX、PSでプリントした際、
>RXがｵｰﾄﾌｨﾙﾀｰの選択ﾎﾞｯｸｽになかった場合はどのようなコードを入れればいいでしょうか？

RXがあるからRXで抽出するのであって、RXが存在しないのに抽出することはないのですが？？
【73821】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/17(日) 16:29 -
引用なし
パスワード
   ▼UO3 さん：

前回ご教授頂いたコードでいろいろ検証して、様々な問題点が出来きまして、
コード自動生成で出来る範囲でやってみたコードが下記です。
このコードをＬ列に出てくる可能性のある数だけ繰り返そうと思ってます。
その際、OGがなかったりする時が出てきた際に下記にIFでコードを入れようとおもうのですが・・・。

VBAプロの方には物足りないというか邪道のような方法かもしれませんが、
とりあえず勉強の為に自分なりにやってみました。

'OGプリント
　 Sheets("Schedule").Select
　　ActiveSheet.Range("$L$9:$L$2000").AutoFilter Field:=1, Criteria1:="OG"
　　Range("B10:M2000").Select
　　Selection.Copy
　　
　　Sheets("print").Select
　　Range("B7").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　　　　:=False, Transpose:=False
　　
　　Application.CutCopyMode = False
　　
　　Range("B3:F3").Select
　　Selection.ClearContents
　　ActiveCell.FormulaR1C1 = "OPEN"
　　
　　ActiveSheet.PrintPreview　　'プリントプレビュー表示

　　
　　Range("B7:M1000").Select
　　Selection.ClearContents
　　Range("A1").Select
　　
　　Sheets("Schedule").Select
　　ActiveSheet.Range("$L$9:$L$2000").AutoFilter Field:=1
　　Range("A1").Select
【73823】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/17(日) 17:31 -
引用なし
パスワード
   ▼nonoka さん：

こんばんは

>前回ご教授頂いたコードでいろいろ検証して、様々な問題点が出来きまして、

その問題点を指摘いただいて、私がアップしたコードを手直しした方が早いと思うますが？
【73824】Re:複数ソートして別々に印刷
回答  nonoka  - 13/2/17(日) 17:54 -
引用なし
パスワード
   ▼UO3 さん：
そうですか・・・。
あれから少々変更して、デバックになるので、あきらめていたのですが。

では、オートフィルタを現在A9〜AA9まで設定しています。
これは消えないようにしたいです。

printシートはコピーしたものだけをクリアしたいです。
プリントシートのB3のセルにはＯＧなどの項目を表示させたいです。

イメージはprintシートの印刷テンプレートにOGならOGだけを抽出してという感じしたいです。
【73826】Re:複数ソートして別々に印刷
発言  UO3  - 13/2/18(月) 9:45 -
引用なし
パスワード
   ▼nonoka さん：

おはようございます

>そうですか・・・。

なるほど。では、nonokaさんのお気持ちを尊重して、方針を撤回して
nonokaさんベースのコードに対する対応策を。

オートフィルターで抽出があったかなかったかという判定は
１．オートフィルターを掛ける前に判定
２．オートフィルターを掛けた後に判定
いずれかで対処されたらよろしいですね。

１．のケース

　 If WorksheetFunction.CountIf(Range("L9:L2000"), "OG") > 0 Then
　　　　'オートフィルター含めた処理の実行
　 End If

２．のケース

　　ActiveSheet.Range("$L$9:$L$2000").AutoFilter Field:=1, Criteria1:="OG"
　　If Range("L9:L2000").SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
　　　　'処理実行
　　End If
【73827】Re:複数ソートして別々に印刷
お礼  nonoka  - 13/2/18(月) 10:32 -
引用なし
パスワード
   ▼UO3 さん：
>
>１．のケース
>
>　 If WorksheetFunction.CountIf(Range("L9:L2000"), "OG") > 0 Then
>　　　　'オートフィルター含めた処理の実行
>　 End If
>
こちらのわがままを対応して頂きありがとうございました。
１．のケースでとりあえず、対応出来ました。
画面が、チカチカして、不細工ですが、とりあえずこれでいきます。

ありがとうございました。助かりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1530 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free