Excel VBA質問箱 IV

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

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


4122 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【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行目)で改ページがちゃんと打たれるのですが,
同一の品物が多くなると,品物が切り替わる前のところでいちど自動的に改ページ
が打たれます。
この自動改ページが例えば,新規と廃棄の間に打たれてしまったりするのです
が,これをうまく「品物:・・」・の手前で改ページにしたい場合どのようにしたらよいのかがわかりません。
よろしくお願いします。

【58313】Re:改ページ
回答  りん E-MAIL  - 08/10/18(土) 13:55 -

引用なし
パスワード
   パトラッシュ さん、こんにちわ。

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

左3文字が「品物:」の時に前回と比較して一致しなければ改ページを入れます。

Sub test()
  With ActiveSheet
   With .UsedRange
     Rmax = .Cells(.Count).Row
   End With
   '
   For II& = 1 To Rmax
     '左3文字が「品物:」の時にチェック
     If Left(.Cells(II&, 1).Value, 3) = "品物:" Then
      If a1$ = "" Then
        '初回はスルー
        a1$ = .Cells(II&, 1).Value
      Else
        '品物:なんとか が一致しなければ手動改ページを入れて、入れ替え
        If a1$ <> .Cells(II&, 1).Value Then
         .HPageBreaks.Add Before:=.Cells(II&, 1)
         a1$ = .Cells(II&, 1).Value
        End If
      End If
     End If
   Next
  End With
End Sub

こんな感じです。

【58315】Re:改ページ
質問  パトラッシュ  - 08/10/18(土) 16:03 -

引用なし
パスワード
   >りん さん:
ご回答ありがとうございます。

私の説明が悪かったのかもしれません。

>>品物が切り替わる部分で改ページを打ちたい
これは,うまくいきます。OKです。

>>同一の品物が多くなると,品物が切り替わる前のところでいちど自動的に改ページが打たれます。

例えば,「品物:りんご」だけで50行くらいになったとしますよね。
そうすると次の「品物:ばなな」に切り替わる前に1ページでは収まらないので
「品物:りんご」の中のどこか中途半端なところで自動改ページされてしまいます。
この自動改ページが必ずしも「品物:・・・」のところではないので,この自動改ページだけをうまくずらしたいのです。
提示していただいた構文でもこの部分がうまくいかないのです。

よろしくお願いします。

【58316】Re:改ページ
回答  りん E-MAIL  - 08/10/18(土) 17:34 -

引用なし
パスワード
   パトラッシュ さん、こんばんわ。

>>>品物が切り替わる部分で改ページを打ちたい
>これは,うまくいきます。OKです。
>
>>>同一の品物が多くなると,品物が切り替わる前のところでいちど自動的に改ページが打たれます。
>
>例えば,「品物:りんご」だけで50行くらいになったとしますよね。
>そうすると次の「品物:ばなな」に切り替わる前に1ページでは収まらないので
>「品物:りんご」の中のどこか中途半端なところで自動改ページされてしまいます。
>この自動改ページが必ずしも「品物:・・・」のところではないので,この自動改ページだけをうまくずらしたいのです。
>提示していただいた構文でもこの部分がうまくいかないのです。
早合点してました、すみません。
品物が異なる部分に手動改ページを入れて、自動改ページが入ったらそれより上の「品物」位置にあらためて改ページを追加します。

Sub test()
  Dim hpb As HPageBreak
  '
  With ActiveSheet
   With .UsedRange
     Rmax = .Cells(.Count).Row
   End With
   '
   For II& = 1 To Rmax
     '左3文字が「品物:」の時にチェック
     If Left(.Cells(II&, 1).Value, 3) = "品物:" Then
      If a1$ = "" Then
        '初回はスルー
        a1$ = .Cells(II&, 1).Value
      Else
        '品物:なんとか が一致しなければ手動改ページを入れて、入れ替え
        If a1$ <> .Cells(II&, 1).Value Then
         .HPageBreaks.Add Before:=.Cells(II&, 1)
         a1$ = .Cells(II&, 1).Value
        End If
      End If
     End If
   Next
   '自動改行がなくなるまで移動
   Application.ScreenUpdating = False 'ウィンドウを切り替えるため
   Do
     '改ページ位置再計算(エラー回避、今は不要かもしれない)
     ActiveWindow.View = xlPageBreakPreview
     ActiveWindow.View = xlNormalView
     'チェック開始
     Hflg = False
     For Each hpb In .HPageBreaks
      If hpb.Type = xlPageBreakAutomatic Then
        II& = hpb.Location.Row
        Do Until II& = 1
         If Left(.Cells(II&, 1).Value, 3) = "品物:" Then
          .HPageBreaks.Add Before:=.Cells(II&, 1)
          Hflg = True: Exit For '外側ループも抜ける
         End If
         II& = II& - 1
        Loop
      End If
     Next
   Loop While Hflg = True
   Application.ScreenUpdating = True
  End With
End Sub
こんな感じです。
1つの品物リストで1頁を超えるような場合は無限ループに入るので注意が必要です。

【58318】Re:改ページ
お礼  パトラッシュ  - 08/10/18(土) 18:47 -

引用なし
パスワード
   >りん さん
早々ご回答ありがとうございます。OKです。

>早合点してました、すみません。
とんでもないです。こちらこそ。
自動改ページを制御することは無理なのかなと半ばあきらめていましたので
新たな発見をさせていただきました。勉強になります。

【58327】Re:改ページ
発言  パトラッシュ  - 08/10/19(日) 0:41 -

引用なし
パスワード
   >1つの品物リストで1頁を超えるような場合は無限ループに入るので注意が必要です。

なるほど。
1ページを超えて2ページ以内までなら対応可能なことを確認しました。
いろいろ検証してみたのですが、例えばりんごだけで3ページにまたがるとか
りんごが2ページ+ばななが2ページとかいうパターンになってしまうと
自動改ページ(中途半端な改ページ)の位置を修正することはできないみたいですね。
う〜ん やはりこれが限界でしょうか?

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