Excel VBA質問箱 IV

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

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


63725 / 76732 ←次へ | 前へ→

【17601】Re:転記がうまく出来ない
回答  かみちゃん  - 04/9/3(金) 9:33 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 下記のコードは、データシートの内容を一部づつ作業用シートにコピーし、作業用シートからラベルシートに転記し、印刷、次のデータを同じようにコピー、転記、印刷したいと思って作成したのですが、うまく思っているように出来ません。

まず、
>上記を作動させますと、1回目の番号1から5の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。

> まず、データシートの番号1〜5(2行目から6行目)を作業シートのセル"A1"にコピーする。
>
> 作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。
とあるのですが、データシートの番号1〜5は、ラベルの左側か右側かどちらに転記させたいのでしょうか?

次に、
ichinoseさんもコメントされていますが、
> If n Mod 2 = o Then
がおかしいです。
 If n Mod 2 = 0 Then
ではないかと思います。

次に、
> m = WorksheetFunction.RoundUp(a / 5, 0)
と、5行ごとのグループ数を取得しているのに、
> For n = 1 To 2      '1シートに10行分転記する
は、不要なような気がします。
その代わり、さきほどの
 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
は、作業用シートは5行しかないはずですから
> 〜 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
 'データシートより5行づつ、作業用シートに取り込む
 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

0 hits

【17591】転記がうまく出来ない NAO 04/9/2(木) 23:46 質問
【17596】Re:転記がうまく出来ない ichinose 04/9/3(金) 7:09 発言
【17602】Re:転記がうまく出来ない NAO 04/9/3(金) 9:43 質問
【17603】Re:転記がうまく出来ない かみちゃん 04/9/3(金) 10:14 回答
【17604】Re:試みてみます NAO 04/9/3(金) 10:49 質問
【17617】Re:ありがとうございました NAO 04/9/3(金) 12:58 お礼
【17601】Re:転記がうまく出来ない かみちゃん 04/9/3(金) 9:33 回答
【17615】Re:転記OKです! NAO 04/9/3(金) 12:50 お礼
【17619】Re:印刷部分が・・ NAO 04/9/3(金) 14:02 質問
【17620】Re:印刷部分が・・ かみちゃん 04/9/3(金) 14:17 回答
【17622】Re:印刷部分が・・うまくいきました NAO 04/9/3(金) 14:33 お礼

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