Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9684 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【25999】印刷範囲の複数指定について にっさん 05/6/21(火) 12:17 質問[未読]
【26001】Re:印刷範囲の複数指定について IROC 05/6/21(火) 12:30 回答[未読]
【26003】Re:印刷範囲の複数指定について りん 05/6/21(火) 14:05 回答[未読]
【26004】Re:印刷範囲の複数指定について だるま 05/6/21(火) 14:33 回答[未読]
【26025】Re:印刷範囲の複数指定について にっさん 05/6/22(水) 10:08 発言[未読]
【26043】Re:印刷範囲の複数指定について にっさん 05/6/22(水) 14:48 お礼[未読]
【26044】Re:印刷範囲の複数指定について りん 05/6/22(水) 14:55 発言[未読]
【25999】印刷範囲の複数指定について
質問  にっさん  - 05/6/21(火) 12:17 -
引用なし
パスワード
   表の中のコードを読み込み、同じコードごとに印刷範囲を指定したいのです。
例えば、
　1行目　A
　2行目　A
　3行目　B
　4行目　C
　5行目　C
　6行目　C
　7行目　D
なら、1，2行目、3行目、4，5，6行目、7行目で分けたいという感じです。

ActiveSheet.PageSetup.PrintArea = ("A1:X2")
ActiveSheet.PageSetup.PrintArea = ("A3:X3")
ActiveSheet.PageSetup.PrintArea = ("A4:X6")
ActiveSheet.PageSetup.PrintArea = ("A7:X7")

とすると、最後の7行目だけしか範囲指定されません。
かといって

ActiveSheet.PageSetup.PrintArea = ("A1:X2,A3:X3,A4:X6,…

では件数が少ない時はいいですが多いときにはやってられません。
ちなみに今回のデータは5万件くらいで1000種類位のコードがあります。
なにかほかにいい方法はないでしょうか？
よろしくお願いします。
【26001】Re:印刷範囲の複数指定について
回答  IROC  - 05/6/21(火) 12:30 -
引用なし
パスワード
   １．フィルタオプションで重複を無視したデータを、ほかのシートに出力する。
２．抽出したリストをキーワードに順番にオートフィルタしながら印刷する。
というのは如何でしょう？
【26003】Re:印刷範囲の複数指定について
回答  りん E-MAIL  - 05/6/21(火) 14:05 -
引用なし
パスワード
   にっさん さん、こんにちわ。

>表の中のコードを読み込み、同じコードごとに印刷範囲を指定したいのです。
>例えば、
>　1行目　A
>　2行目　A
>　3行目　B
>　4行目　C
>　5行目　C
>　6行目　C
>　7行目　D
>なら、1，2行目、3行目、4，5，6行目、7行目で分けたいという感じです。
　===中略===
>なにかほかにいい方法はないでしょうか？
ページを変えたいだけならば、手動改ページを入れる方法もあります。

Sub test()
　 Dim RR As Long, Rmax As Long, ws As Worksheet
　 Set ws = ActiveWorkbook.ActiveSheet
　 '最下行判定
　 With ws.UsedRange
　　　Rmax = .Cells(.Count).Row
　 End With
　 '改ページ挿入位置検索（コードがＢ列の例）
　 With ws
　　　'改ページ位置を何度も計算することになるので止めておくと処理が速くなる
　　　.DisplayPageBreaks = False
　　　For RR = 2 To Rmax
　　　　 If .Cells(RR, 2).Value <> .Cells(RR - 1, 2).Value Then
　　　　　　.HPageBreaks.Add .Cells(RR, 2)
　　　　 End If
　　　Next
　　　.DisplayPageBreaks = True
　 End With
End Sub

こんな感じです。
【26004】Re:印刷範囲の複数指定について
回答  だるま WEB  - 05/6/21(火) 14:33 -
引用なし
パスワード
   こんにちは

地道にループで処理してみました。^d^

Sub 種類毎に印刷()
　　Dim T As Long, B As Long
　　Dim i As Long
　　Dim myVal0 As Variant
　　Dim myVal As Variant
　　
　　i = 1
　　T = 1: B = T
　　myVal0 = Cells(i, 1).Value
　　
　　Do
　　　　i = i + 1
　　　　myVal = Cells(i, 1).Value
　　　　If myVal = "" Then Exit Do
　　　　
　　　　If myVal = myVal0 Then
　　　　　　B = B + 1
　　　　Else
　　　　　　印刷 T, B
　　　　　　T = B + 1
　　　　　　B = T
　　　　　　myVal0 = myVal
　　　　End If
　　Loop
　　印刷 T, B
　　
End Sub

Sub 印刷(T As Long, B As Long)
　　Dim myRange As Range
　　
　　With ActiveSheet
　　　　Set myRange = .Range("A" & T & ":X" & B)
　　　　.PageSetup.PrintArea = myRange.Address
　　　　.PrintPreview
　　End With
　　
　　Set myRange = Nothing
　　
End Sub
【26025】Re:印刷範囲の複数指定について
発言  にっさん  - 05/6/22(水) 10:08 -
引用なし
パスワード
   おはようございます。
IROCさん、りんさん、だるまさん、回答ありがとうございます。

いろいろやった挙句とりあえず目的は達成できました。
で、どうやったかということですが、ちょっと今たてこんでまして
時間がないのでまた後ほどご報告させていただきますので
よかったらまた後で見てくださいm(__)m
【26043】Re:印刷範囲の複数指定について
お礼  にっさん  - 05/6/22(水) 14:48 -
引用なし
パスワード
   こんちわ。先ほどの続きです。

レコードを順番に読み込み、コードが変わった段階で
With ActiveSheet
.Rows(cnt01).PageBrteak = xlManual
End With
というのを入れてなんとかなりました。
これで一件落着、といきたい所ですが、

質問にはのせませんでしたが本当のところ
該当レコードが1件しかないコード（例えば
コード：Ｂが一件だけ）の場合はその行だけ
印刷範囲から除きたかったのですがそれは
出来ませんでした。ま、これは行そのものを
削除してしまって対応したのでいいんですけどね。

とにかく、うまいこといったのでＯＫです。
ありがとうございました。
【26044】Re:印刷範囲の複数指定について
発言  りん E-MAIL  - 05/6/22(水) 14:55 -
引用なし
パスワード
   にっさん さん、こんにちわ。
もう、解決後ですが。

>質問にはのせませんでしたが本当のところ
>該当レコードが1件しかないコード（例えば
>コード：Ｂが一件だけ）の場合はその行だけ
>印刷範囲から除きたかったのですがそれは
>出来ませんでした。ま、これは行そのものを
>削除してしまって対応したのでいいんですけどね。
　行を非表示にするという手もあります。
　Rows(1).Hidden = True
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9684 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free