| |
こんにちは。かみちゃん です。
> 下記のコードは、データシートの内容を一部づつ作業用シートにコピーし、作業用シートからラベルシートに転記し、印刷、次のデータを同じようにコピー、転記、印刷したいと思って作成したのですが、うまく思っているように出来ません。
まず、
>上記を作動させますと、１回目の番号１から５の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。
と
> まず、データシートの番号１〜５（２行目から６行目）を作業シートのセル"A1"にコピーする。
>
> 作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。
とあるのですが、データシートの番号１〜５は、ラベルの左側か右側かどちらに転記させたいのでしょうか？
次に、
ichinoseさんもコメントされていますが、
> If n Mod 2 = o Then
がおかしいです。
If n Mod 2 = 0 Then
ではないかと思います。
次に、
> m = WorksheetFunction.RoundUp(a / 5, 0)
と、５行ごとのグループ数を取得しているのに、
> For n = 1 To 2 '１シートに１０行分転記する
は、不要なような気がします。
その代わり、さきほどの
If n Mod 2 = 0 Then
で、右側への転記か左側の転記の処理をしていると思いますので、
これを
If z Mod 2 = 0 Then
とすればいいかと思います。
次に、
> For j = h To i
の変数hは、データシートのコピー開始行なので、これをjに入れて作業シートの開始行にするのでしょうか？作業シートのA1に貼り付けているので違うと思います。
そこで、
For j = h - (z - 1) * 5 To i - (z - 1) * 5
としないといけません。
次に、
> 〜 Worksheets("作業用").Cells(j + 4, 2).Value
は、作業用シートは５行しかないはずですから
> 〜 Worksheets("作業用").Cells(j -1, 2).Value
だと思います。
あと、まちがいではないですが、
> For j = h To i
> For k = h To i
> For p = h To i
> For q = h To i
これらは、ひとつにまとめられると思います。
>データシート上のコマンドボタンにより転記。コードは次のようになっています。
以上を修正して、さらに効率のいいと思われるコードにすると、以下のようになります。動作確認していますので、お試しください。
Private Sub CommandButton1_Click()
Dim lstrow As Integer, a As Integer, m As Integer, h As Integer, i As Integer, j As Integer
Dim z As Integer
Application.ScreenUpdating = False
'データシートより５行づつ、作業用シートに取り込む
Worksheets("データ").Activate
lstrow = Worksheets("データ").Range("a65536").End(xlUp).Row
a = lstrow
m = WorksheetFunction.RoundUp(a / 5, 0)
For z = 1 To m
h = z * 5 - 3
i = z * 5 + 1
Worksheets("データ").Range("a" & h & ":d" & i).Copy Destination:=Worksheets("作業用").Range("a1")
'作業用シートのデータをラベルシートに転記する
For j = h - (z - 1) * 5 To i - (z - 1) * 5
'名前
Worksheets("ラベル").Cells(j * 10 - 18, 3 + (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 2).Value
'備考
Worksheets("ラベル").Cells(j * 10 - 18, 8 + (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 4).Value
'品名
Worksheets("ラベル").Cells(j * 10 - 11, 5 + (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 3).Value
'番号
Worksheets("ラベル").Cells(j * 10 - 11, 13 + (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 1).Value
Next j
'ラベルシートの印刷
MsgBox "用紙をセットしてください"
Worksheets("ラベル").Activate
ActiveSheet.PrintOut copies:=1
Next z
MsgBox "すべての印刷終了"
Application.ScreenUpdating = True
End Sub
|
|
かみちゃん
- 04/9/3(金) 9:33 -
