Excel VBA質問箱 IV

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

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


23789 / 76738 ←次へ | 前へ→

【58309】改ページ
質問  パトラッシュ  - 08/10/17(金) 22:18 -

引用なし
パスワード
   以下のようなファイルがあります。

      A         B         C
1  品物:りんご
2  産地:あおもり
3  種別:1
4              品物       産地
5    新規        1         2
6    廃棄        1         2

8  品物:りんご
9  産地:あきた
10 種別:3
11             品物       産地
12   新規        1         3
13   廃棄        1         3
14   新規        1         3
15   廃棄        1         3
16
17 品物:りんご
 :    :
:    :
28 品物:ばなな
29 産地:鹿児島
30 種別:5
31             品物       産地
32   新規        3         1
33   廃棄        3         1
34
35 品物:ばなな
:    :  

新規・廃棄の欄は12・13・14・15行のように一つの産地の中で複数になる場合もあります。
同じ品物が出てくる(1・8・17行目)数もそのときによって異なります。

品物が切り替わる部分で改ページを打ちたい(上記では28行目でりんごからばななへと切り替わる)
ので,下記のようなマクロ構文を作成しました。

Sub Macro()

  Columns("A:A").Select
  Selection.AutoFilter
  Range("A1:A9999").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  
  Call Sample
  
  ActiveSheet.ShowAllData
  
End Sub
==================================================

Sub Sample()
 Dim Rng As Range
 Dim c As Range
 Dim firstAddress As String

 ActiveSheet.ResetAllPageBreaks

 With ActiveSheet.Range("A2:A9999").Columns(1)
  Set c = .Find("品物", LookIn:=xlValues, lookat:=xlPart)
  If Not c Is Nothing Then
   firstAddress = c.Address
   Do
    c.Offset(0).PageBreak = xlPageBreakManual
    c.Select
    Set c = .FindNext(c)
    If c Is Nothing Then Exit Do
   Loop Until c.Address = firstAddress
  End If
 End With
End Sub

これで,品物が切り替わる部分(上記だと28行目)で改ページがちゃんと打たれるのですが,
同一の品物が多くなると,品物が切り替わる前のところでいちど自動的に改ページ
が打たれます。
この自動改ページが例えば,新規と廃棄の間に打たれてしまったりするのです
が,これをうまく「品物:・・」・の手前で改ページにしたい場合どのようにしたらよいのかがわかりません。
よろしくお願いします。
0 hits

【58309】改ページ パトラッシュ 08/10/17(金) 22:18 質問
【58313】Re:改ページ りん 08/10/18(土) 13:55 回答
【58315】Re:改ページ パトラッシュ 08/10/18(土) 16:03 質問
【58316】Re:改ページ りん 08/10/18(土) 17:34 回答
【58318】Re:改ページ パトラッシュ 08/10/18(土) 18:47 お礼
【58327】Re:改ページ パトラッシュ 08/10/19(日) 0:41 発言

23789 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free