[[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


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.