Excel VBA質問箱 IV

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

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


11182 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【17591】転記がうまく出来ない
質問  NAO  - 04/9/2(木) 23:46 -

引用なし
パスワード
   こんばんは、NAOです。またお世話になります。

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

どこがまずいのかご指摘ねがいたいと思います。よろしくお願いします。

(データシート)・・・データ数は一定ではありません
  a  b   c    d
1 番号 名前  品名  備考
2  1  井上  定規  1組
3  2  坂本  鉛筆  1ダース
4  3  中村  ペン  赤色
.  .  .   .    .
.  .  .   .    .


まず、データシートの番号1〜5(2行目から6行目)を作業シートのセル"A1"にコピーする。

 作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。

 引き続き、データシートの番号6〜10(7行目から11行目)を作業シートのセル"A1"にコピーする。

 作業用シートの内容をラベルシートの左側半分の所定の位置に転記する。

ラベルシートを印刷する。 

上記の手順を、データシートの最終番号まで繰り返す。

 転記先のラベルシートの所定の位置ですが、一寸文章で書くとややこしいのですが、次のとおりです。


   (作業シート)⇒(ラベルシート右側) (ラベルシートの左側)
1行目の  A1 ⇒ M9           AB9
データ   B1 ⇒ C2            R2
      C1 ⇒ E9            T9
      D1 ⇒ H2            W2

2行目の  A2 ⇒ M19          AB19
データ   B2 ⇒ C12           R12
      C2 ⇒ E19           T19
      D2 ⇒ H12           W12

以下、5行目まで同じ間隔でコピーします。

データシート上のコマンドボタンにより転記。コードは次のようになっています。

Private Sub CommandButton1_Click()

Dim lstrow As Integer, a As Integer, m As Integer, n As Integer, h As Integer,i As Integer, j As Integer, k As Integer, p As Integer, q 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 n = 1 To 2      '1シートに10行分転記する
    
    '名前
      
      For j = h To i
        If n Mod 2 = o Then
          Worksheets("ラベル").Cells(j * 10 - 18, 3).Value =Worksheets("作業用").Cells(j - 1, 2).Value
          Else: Worksheets("ラベル").Cells(j * 10 - 18, 18).Value = Worksheets("作業用").Cells(j + 4, 2).Value
        End If
      Next j
      
    '備考
    
      For k = h To i
        If n Mod 2 = o Then
          Worksheets("ラベル").Cells(k * 10 - 18, 8).Value = Worksheets("作業用").Cells(k - 1, 4).Value
          Else: Worksheets("ラベル").Cells(k * 10 - 18, 23).Value = Worksheets("作業用").Cells(k + 4, 4).Value
        End If
      Next k
      
    '品名
    
      For p = h To i
        If n Mod 2 = o Then
          Worksheets("ラベル").Cells(p * 10 - 11, 5).Value = Worksheets("作業用").Cells(p - 1, 3).Value
          Else: Worksheets("ラベル").Cells(p * 10 - 11, 20).Value = Worksheets("作業用").Cells(p + 4, 3).Value
        End If
      Next p
      
    '番号
    
      For q = h To i
        If n Mod 2 = o Then
          Worksheets("ラベル").Cells(q * 10 - 11, 13).Value = Worksheets("作業用").Cells(q - 1, 1).Value
          Else: Worksheets("ラベル").Cells(q * 10 - 11, 28).Value = Worksheets("作業用").Cells(q + 4, 1).Value
        End If
      Next q
      
    Next n
    
  'ラベルシートの印刷
  
    MsgBox "用紙をセットしてください"
  
    Worksheets("ラベル").Activate
      ActiveSheet.PrintOut copies:=1
      
  Next z
   
  MsgBox "すべての印刷終了"
   
  Application.ScreenUpdating = True
  
End Sub
 
上記を作動させますと、1回目の番号1から5の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。

うまく説明出来ておらず、分かりづらい質問ですがよろしくお願いします。

【17596】Re:転記がうまく出来ない
発言  ichinose  - 04/9/3(金) 7:09 -

引用なし
パスワード
   ▼NAO さん:
おはようございます。
ちゃんとトレースしたわけではありませんが・・・・。

>こんばんは、NAOです。またお世話になります。
>
>Private Sub CommandButton1_Click()
>
>Dim lstrow As Integer, a As Integer, m As Integer, n As Integer, h As Integer,i As Integer, j As Integer, k As Integer, p As Integer, q 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 n = 1 To 2      '1シートに10行分転記する
>    
>    '名前
>      
>      For j = h To i
>        If n Mod 2 = o Then
'                ↑ 偶数か奇数を判別がoですが、0ですよね?
'        以下の行にも同じコードがこれを修正して下さい
>          Worksheets("ラベル").Cells(j * 10 - 18, 3).Value =Worksheets("作業用").Cells(j - 1, 2).Value
>          Else: Worksheets("ラベル").Cells(j * 10 - 18, 18).Value = Worksheets("作業用").Cells(j + 4, 2).Value
>        End If
>      Next j
>      
>    '備考
>    
>      For k = h To i
>        If n Mod 2 = o Then
>          Worksheets("ラベル").Cells(k * 10 - 18, 8).Value = Worksheets("作業用").Cells(k - 1, 4).Value
>          Else: Worksheets("ラベル").Cells(k * 10 - 18, 23).Value = Worksheets("作業用").Cells(k + 4, 4).Value
>        End If
>      Next k
>      
>    '品名
>    
>      For p = h To i
>        If n Mod 2 = o Then
>          Worksheets("ラベル").Cells(p * 10 - 11, 5).Value = Worksheets("作業用").Cells(p - 1, 3).Value
>          Else: Worksheets("ラベル").Cells(p * 10 - 11, 20).Value = Worksheets("作業用").Cells(p + 4, 3).Value
>        End If
>      Next p
>      
>    '番号
>    
>      For q = h To i
>        If n Mod 2 = o Then
>          Worksheets("ラベル").Cells(q * 10 - 11, 13).Value = Worksheets("作業用").Cells(q - 1, 1).Value
>          Else: Worksheets("ラベル").Cells(q * 10 - 11, 28).Value = Worksheets("作業用").Cells(q + 4, 1).Value
>        End If
>      Next q
>      
>    Next n
>    
>  'ラベルシートの印刷
>  
>    MsgBox "用紙をセットしてください"
>  
>    Worksheets("ラベル").Activate
>      ActiveSheet.PrintOut copies:=1
>      
>  Next z
>   
>  MsgBox "すべての印刷終了"
>   
>  Application.ScreenUpdating = True
>  
>End Sub
> 
>上記を作動させますと、1回目の番号1から5の内容をラベルシートの左側にうまく敵されますが、右側には何も転記されません。
それから・・・、
見せていただいたコードの仕様は、

本来は、「データシートの内容を5行づつ、ラベルシートに転記し、印刷する」
というこでしょうか?
作業シートに転記する必要性が見えなかったのですが・・・。
他に理由があったのなら、余計なお世話ですが・・・。

【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

【17602】Re:転記がうまく出来ない
質問  NAO  - 04/9/3(金) 9:43 -

引用なし
パスワード
   ▼ichinose さん:
おはようございます。いつもすみません。

>本来は、「データシートの内容を5行づつ、ラベルシートに転記し、印刷する」
>というこでしょうか?

データシートの番号1〜5をラベルシートの左側半分の所定の位置に、番号6〜10を
同じラベルシートの右側半分の所定の位置に転記し、印刷。印刷が終われば、番号11〜15を左に、番号16〜20を右側にと繰り返していきたいと考えています。

>作業シートに転記する必要性が見えなかったのですが・・・。
>他に理由があったのなら、余計なお世話ですが・・・。

本来のデータシートには、10列の項目があり、その内、ラベルに転記するのは4項目です。
元のコードには、データシート(10項目の列のあるシート)から必要な項目列(4列)を別シートに抜き出すようにしています。(この抜き出したシートは、別の目的のためプリントアウトする必要があるため)

今回は、抜き出した後の状態で質問させて頂いてます。よろしくお願いします。

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

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

横から失礼します。

>データシートの番号1〜5をラベルシートの左側半分の所定の位置に、番号6〜10を
>同じラベルシートの右側半分の所定の位置に転記し、印刷。印刷が終われば、番号11〜15を左に、番号16〜20を右側にと繰り返していきたいと考えています。

であれば、最初のご質問の
> まず、データシートの番号1〜5(2行目から6行目)を作業シートのセル"A1"にコピーする。
>
>  作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。
は、違うということでいいですか?

違うのであれば、先ほど私が提示したコードも違いますので、以下の部分を差し替えてください。
  '作業用シートのデータをラベルシートに転記する
  For j = h - (z - 1) * 5 To i - (z - 1) * 5
   '名前
   Worksheets("ラベル").Cells(j * 10 - 18, 18 - (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 2).Value
   '備考
   Worksheets("ラベル").Cells(j * 10 - 18, 23 - (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 4).Value
   '品名
   Worksheets("ラベル").Cells(j * 10 - 11, 20 - (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 3).Value
   '番号
   Worksheets("ラベル").Cells(j * 10 - 11, 28 - (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 1).Value
  Next j

【17604】Re:試みてみます
質問  NAO  - 04/9/3(金) 10:49 -

引用なし
パスワード
   ▼かみちゃん さん:
NAOです。いつもお世話になっています。

>>  作業用シートの内容をラベルシートの右側半分の所定の位置に転記する。
>は、違うということでいいですか?

はい、記入間違いしていました。1〜5は左側です。すみません。

>違うのであれば、先ほど私が提示したコードも違いますので、以下の部分を差し替えてください。

先ほど回答いただいたコードを試そうとしていたところです。
結果を、後ほど投稿したいと思います。ありがとうございました!

【17615】Re:転記OKです!
お礼  NAO  - 04/9/3(金) 12:50 -

引用なし
パスワード
   ▼かみちゃん さん:
NAOです。
[17603]で回答いただきましたコードで希望しているとおりに作動しました。
ありがとうございました。

>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, 18- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 2).Value
>   '備考
>   Worksheets("ラベル").Cells(j * 10 - 18, 23- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 4).Value
>   '品名
>   Worksheets("ラベル").Cells(j * 10 - 11, 20- (z Mod 2) * 15).Value = Worksheets("作業用").Cells(j - 1, 3).Value
>   '番号
>   Worksheets("ラベル").Cells(j * 10 - 11, 28- (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


本当にありがとうございました。

【17617】Re:ありがとうございました
お礼  NAO  - 04/9/3(金) 12:58 -

引用なし
パスワード
   ▼ichinose さん:

ありがとうございました。皆さんのおかげで解決しました。

分からないことが出てきたときには、また質問させていただきますので
その折にはよろしくお願いいたします。

【17619】Re:印刷部分が・・
質問  NAO  - 04/9/3(金) 14:02 -

引用なし
パスワード
   ▼かみちゃん さん:
すみません。

転記部分はOKなんですが、印刷のところについて、ラベルシートに左に5行分、右に5行分、計10行分転記されたら印刷としたいのですが、試行してみましたら左側へ5行分転記した時点で印刷、右側に5行分追加転記されて印刷となります。

10行分転記されたら印刷するに修正方よろしくお願いします。
お願いばかりで申し訳ありません。

【17620】Re:印刷部分が・・
回答  かみちゃん  - 04/9/3(金) 14:17 -

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

>10行分転記されたら印刷するに修正方よろしくお願いします。

申し訳ございません。バグです。

>  'ラベルシートの印刷
>  MsgBox "用紙をセットしてください"
>  Worksheets("ラベル").Activate
>  ActiveSheet.PrintOut copies:=1

の部分を下記のようにしてください。
  'ラベルシートの印刷
  If z Mod 2 = 0 Or z = m Then
   MsgBox "用紙をセットしてください"
   Worksheets("ラベル").Activate
   ActiveSheet.PrintOut copies:=1
  End If

【17622】Re:印刷部分が・・うまくいきました
お礼  NAO  - 04/9/3(金) 14:33 -

引用なし
パスワード
   ▼かみちゃん さん:
ありがとうございました。助かりました。


if 文で、i=11の整数倍で印刷と考えていたのですが
結局、出来ませんでした。
もっと、勉強せねばと痛感しております。

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