プロが教えるわが家の防犯対策術!

Excel マクロは私にとっていばらの道です。

__________A______B_____C_____D
1_______名前____金額__日付__摘要
2______あああ__55555___6___kkk
3______いいい__________6___hhh
4______ううう__33333___6___ppp
---------------------------------
5______えええ__44444___8___ggg
6______おおお__77777___8___lll
7______あいう__22222___8___rrr

一つのシートを、A2:D4 と A5:D7 の2枚に分けて印刷するマクロを作りたいと考えています。

A1:D1の項目行は、「印刷タイトル」に設定してあります。
金額は空欄の場合もありますが、A名前、C日付とD摘要は連続です。
データ行は増えたり減ったりし、一定ではありません。

日付けの変わるところが印刷区分です。この日付の変わり目をつかまえて印刷範囲を指定できると思っていますが、なかなか巧くいきません。
印刷区分は、範囲設定でなく、ページ区分でもかまいません。

なるべく行数の少ないスカッとしたマクロにするにはどうしたらよいでしょうか。
教えて下さい。よろしくお願いします。

A 回答 (3件)

こんにちは。



見出しもマクロで設定します。お試しください。

Sub 印刷()
  Dim wR   As Long
  Dim maxR  As Long
  With ActiveSheet
    maxR = .Range("A" & Rows.Count).End(xlUp).Row
    For wR = 3 To maxR
      If .Cells(wR, 3).Value <> Cells(wR - 1, 3) Then
        '日付が変わる時、改頁の Break Point設定
        .Rows(wR).PageBreak = xlPageBreakManual
      End If
    Next
  End With
  With ActiveSheet.PageSetup
    .PrintTitleRows = "$1:$1"   '←1行見出し
    .PrintArea = "A1:D" & maxR   '←印刷範囲設定
  End With
  ActiveSheet.PrintOut
End Sub

この回答への補足

pkh4989さん ありがとうございます。
実際はもう少し大きい表で、編集したいので教えて下さい。

> For wR = 3 To maxR
> If .Cells(wR, 3).Value <> Cells(wR - 1, 3) Then

> .PrintTitleRows = "$1:$1"

これは見出し行が2行、日付が列 E にある場合次のようにしてよいですか。

 For wR = 4 To maxR
If .Cells(wR, 5).Value <> Cells(wR - 1, 5 ) Then

.PrintTitleRows = "$1:$2"

表の下に、別の記事がある場合、印刷を表の部分のみで終わりにするとき、どうしたらよいですか。

よろしくお願いします。

補足日時:2007/06/26 11:20
    • good
    • 0
この回答へのお礼

pkh4989さん ありがとうございました。

お礼日時:2007/06/26 14:08

こんにちは。



>これは見出し行が2行、日付が列 E にある場合次のようにしてよいですか。
> For wR = 4 To maxR
>If .Cells(wR, 5).Value <> Cells(wR - 1, 5 ) Then
>
>.PrintTitleRows = "$1:$2"
OKです

>表の下に、別の記事がある場合、印刷を表の部分のみで終わりにするとき、どうしたらよいですか。
行の最大を求めるのはA列ですので、「別の記事」がA列のなければ、大丈夫です。
    • good
    • 0
この回答へのお礼

pkh4989さん ありがとうございます。
別の記事をB列より右に移して巧くいきました。

なお、前に使ったページ区分を引きずらないよう、冒頭に「印刷範囲クリア」のコードを入れました。
ActiveSheet.PageSetup.PrintArea = ""

お礼日時:2007/06/26 14:07

> A1:D1の項目行は、「印刷タイトル」に設定してあります。


という前提です。
C列が日付欄として、日付の変わり目に改ページを挿入します。

Sub Test()
 Dim i
 i = 3
 Do Until Cells(i, 3) = ""
  If Cells(i, 3).Value <> Cells(i - 1, 3) Then
   Rows(i).Select
   ActiveWindow.SelectedSheets.HPageBreaks.Add _
          Before:=ActiveCell
  End If
  i = i + 1
 Loop
 'ActiveSheet.PrintOut
End Sub

1行目はタイトル行、データが2行目からですので、3行目の日付が2行目と
同じかどうか、からチェックを開始しています。
違っていたら、その行を選択して改ページを挿入します。

この回答への補足

misatoannaさん ありがとうございます。
質問の条件が書ききれていませんでした。

表の右にも下にも別の記事があって、表の部分だけを2枚に抜き出して印刷したいのです。
よろしくお願いします。

補足日時:2007/06/26 11:41
    • good
    • 0
この回答へのお礼

misatoannaさん ありがとうございました。

お礼日時:2007/06/26 14:10

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!