[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『キーのチェックと数量カウントについて』(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 >
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
コードありがとうございます。
早速下記のようにしてみました。
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さんのおっしゃる通り
コードをそのまま分けて実行したら思うとおりの動きになりました。
キーのチェック→キーが変わった→印刷→キーのチェック…
となるもんだと頭の中で思っていました。
すいません、助かりました。
お手数おかけしました。
(JK) 2017/05/18(木) 16:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.