|
|
| Excel VBA Macro ・ コピー ・ FAQ |
|
数量がゼロでない行だけをコピーして別のシートに貼り付けるには？
|
|
|
|
Question 74.1 |
|
 |
 |
|
|
シート1、シート2、シート3
シート1、2、3の項目・摘要・数量・単価・金額の内容を、数量の入っている物のみ契約用シートに貼付するのですが上手く出来ません。 (数量の無い物は詰める)
(シート1〜3は各20行、罫線で枠切有り。契約シートの枠はそのまま)
契約用シート
(契約シートにも項目・摘要・数量・単価・金額欄有り)
'Wsa シート1
'Wskeiyaku 契約用シート
For a = 5 To (5 + 15)
If Wska.Cells(a, 7) <> 0 Then
Wska.Cells(a, 2).Copy
Wskeiyaku.Cells(1 + a, 2).PasteSpecial Paste:=xlPasteValues
Wska.Cells(a, 4).Copy
Wskeiyaku.Cells(1 + a, 5).PasteSpecial Paste:=xlPasteValues
Wska.Cells(a, 6).Copy
Wskeiyaku.Cells(1 + a, 9).PasteSpecial Paste:=xlPasteValues
Wska.Cells(a, 7).Copy
Wskeiyaku.Cells(1 + a, 24).PasteSpecial Paste:=xlPasteValues
Wska.Cells(a, 8).Copy
Wskeiyaku.Cells(1 + a, 25).PasteSpecial Paste:=xlPasteValues
End If
Next a
上記でやってみたのですが、数量の無い所はコピーして来ないのですが、詰める事が出来ません。 宜しく御願いします。
|
|
Answer |
Copyright (C) 2005.7.11 永井善王 |
|
|
回答に先立ってお断りさせてください。
上図の2つのシートは、ご質問の文章とコードに基づいて私が作図したものです。 ちょっと不自然に思われるところがありましたが本題とは無関係のようです。
コピー貼り付けは上手くできるようですから、数量ゼロのときに貼り付け位置を詰める方法に絞ってお答えします。
ご提示のコードは、シート1、2、3の 5行目から20行目を順次処理するために、For...Next文を使っています。
そのときのカウンタは変数 a で、1回繰り返すごとに 1づつ上がっていきます。 このカウンタをシート1等の読み出し行の指定と、契約用シートへの貼り付け行の指定とに共通利用しています。
そのため、コード4行目の If文で数量がゼロと判別された場合でも、貼り付け行がどんどん上がっていきます。
よって、解決策としてはカウンタを別にする必要があります。 具体的には下記のとおりです。
・For...Next文より前に b = 5 のように貼り付け用カウンタに初期値を設定するコードを追加する
・5行あるPasteSpecialのコード中の貼り付け用カウンタを b などに置換する
・貼り付け用カウンタを増加するためのコードを End If文の直前に追加する
これらを修正すると次のようになるはずです。参考にして結果をご連絡ください。
Set wska = Worksheets("シート1")
Set Wskeiyaku = Worksheets("契約")
b = 5
For a = 5 To (5 + 15)
If wska.Cells(a, 7) <> 0 Then
wska.Cells(a, 2).Copy
Wskeiyaku.Cells(1 + b, 2).PasteSpecial Paste:=xlPasteValues
wska.Cells(a, 4).Copy
Wskeiyaku.Cells(1 + b, 5).PasteSpecial Paste:=xlPasteValues
wska.Cells(a, 6).Copy
Wskeiyaku.Cells(1 + b, 9).PasteSpecial Paste:=xlPasteValues
wska.Cells(a, 7).Copy
Wskeiyaku.Cells(1 + b, 24).PasteSpecial Paste:=xlPasteValues
wska.Cells(a, 8).Copy
Wskeiyaku.Cells(1 + b, 25).PasteSpecial Paste:=xlPasteValues
b = b + 1
End If
Next
|
|
|
|
|
