[[20170517160125]]　『キーのチェックと数量カウントについて』（JK）　ページの最後に飛ぶ

『キーのチェックと数量カウントについて』（JK）

いつもお世話になっています。

下記コードですが、あと少し追加したく考えています。
ただ、頭が全くついてこず、またここにきてしまいました。

やりたいことはSheet4に抽出したデータがあります。
例:
　A　　　B　　　C　　　D　　　E
1Z001　1.14
2Z001 2.27
3X002 3.31
4X004 1.10
・
・
・

1.セルA列にあるIDが変われば、印刷というシートにそれまでのデータをコピー　して印刷する

　上記例でいくと「Z001」と「X002」でIDが変わるので
　Z001の2件を印刷シートに貼り付けて印刷する。
　「X002」と「X004」でIDが変わるので、X002の1件をコピーし印刷するような感じです。

ただし、「印刷」シートはB24からB48の25件が縦のMAX、25件以上になるとセルP24からP48に移動したいです。

キーとチェックは下記コードでいけそうなのですが、
カウントと印刷のステップが…。

すいませんが、教えてもらえませんでしょうか。
Sub Page()

    Dim i As Long
    Dim SaveKey As Variant
    Dim SaveKey2 As Variant

    Dim St As String
    Dim StM As String

    i = 1

    St = Worksheets("sheet4").Cells(i, 1).Value 'ID
    SaveKey = Left(St, 4)

    'D列の値が空白になるまでループ
    Do Until Len(Cells(i, 1).Value) = 0

St = Worksheets("sheet4").Cells(i, 1).Value
SaveKey2 = Left(St, 4)

        'キーが変わったかどうかをチェック
        If SaveKey <> SaveKey2 Then

            Rows(i).Insert
            i = i + 1
            'キーを更新
            St = Worksheets("sheet4").Cells(i, 1).Value
            SaveKey = Left(St, 1)

        End If
        i = i + 1
    Loop

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

Sub main()

    Dim t As Range, c As Range, r As Range
    Set t = Union(Sheets("印刷").Range("B24:B48"), Sheets("印刷").Range("P24:P48"))
    For Each c In Sheets("Sheet4").Range("A:A").SpecialCells(xlCellTypeConstants)
        For Each r In t
            If r.Value = Empty Then r.Value = c.Offset(, 1).Value: Exit For
        Next r
        If Left(c.Value, 4) <> Left(c.Offset(1).Value, 4) Then
            Sheets("印刷").PrintPreview
            t.ClearContents
        End If
    Next c
End Sub
（mm） 2017/05/17(水) 17:17

mmさん

　コードありがとうございます。

早速下記のようにしてみました。

Sub Page()

    Dim i As Long
    Dim SaveKey As Variant
    Dim SaveKey2 As Variant

    Dim St As String

    i = 1

    St = Worksheets("sheet4").Cells(i, 1).Value 'ID
    SaveKey = Left(St, 4)

    'D列の値が空白になるまでループ
    Do Until Len(Cells(i, 1).Value) = 0

    St = Worksheets("sheet4").Cells(i, 1).Value
    SaveKey2 = Left(St, 4)

        'キーが変わったかどうかをチェック
    If SaveKey <> SaveKey2 Then
     Dim t As Range, c As Range, r As Range
     Set t = Union(Sheets("印刷").Range("B24:B48"), Sheets("印刷").Range("P24:P48"))
     For Each c In Sheets("Sheet4").Range("A:A").SpecialCells(xlCellTypeConstants)
        For Each r In t
            If r.Value = Empty Then r.Value = c.Offset(, 1).Value: Exit For
        Next r
        If Left(c.Value, 4) <> Left(c.Offset(1).Value, 4) Then
            Sheets("印刷").PrintOut
            t.ClearContents
        End If
     Next c

    '        Rows(i).Insert
            'i = i + 1
            'キーを更新
            'St = Worksheets("sheet4").Cells(i, 1).Value
            'SaveKey = Left(St, 1)

        End If
        i = i + 1
    Loop

End Sub

ただ、どういうわけか、同じ印刷シートが印刷されます。
今、「F8」キーを押しながら1文ずつ解析しているのですが…。

入れる場所が間違っていますでしょうか？
（JK） 2017/05/18(木) 14:44

途中に入れるのではなく、そのまま走らせればいいと思いますが
（mm） 2017/05/18(木) 14:53

mmさん
　
　回答、ありがとうございます。
分かっていなくて申し訳ございませんでした。

正直、まだコードを追っているところですが、mmさんのおっしゃる通り
コードをそのまま分けて実行したら思うとおりの動きになりました。

キーのチェック→キーが変わった→印刷→キーのチェック…
となるもんだと頭の中で思っていました。

すいません、助かりました。

お手数おかけしました。
（JK） 2017/05/18(木) 16:07

コメント返信：

[ 一覧(最新更新順) ]

[[20170517160125]] 『キーのチェックと数量カウントについて』（JK） ページの最後に飛ぶ

[[20170517160125]]　『キーのチェックと数量カウントについて』（JK）　ページの最後に飛ぶ