ＶＢＡ 条件が一致した場合のみコピーする

質問

ＶＢＡについて、現在勉強中な為、色々調べておりますが、詳しい方がおりましたら教えてください。

在庫管理の表をエクセルでやっております。

注文が来て、品物の手配をする時に、在庫の有無を確認したいので下記のような事が出来れば
良いと思っております。
３つのシートを使っております。シート名は、”必要数””出荷数””在庫数”

シート：”在庫数”では、入荷数の合計から、マクロを使ってコピーした”出荷数”の数を
差し引くことにより、発注手配が必要な物とそうでない物がわかりやすいように作りたいと思って
おります。

今回は、注文来た数を出荷数のシートにＶＢＡでコピーさせる方法の質問です。

シート名：”必要数”　のセルＣ２：Ｃ：５０　を、コピーして、隣のシート”出荷数”のＡ列の
一番上の空白に、形式を選択して貼り付け（値・行列を入れ替える）
ただし、Ａ列には、日付が入力されてる為、参照した空白の一つ上のセルがコピー元と同じ
日付なら、貼り付けをしないでエラー表示させたい。

自動マクロでは、コピー元を選択して、ここに貼り付けみたいな事はできたのですが
３行目に貼り付けした後は、４行目に貼り付けるという自動マクロがわかりません。

ネットで調べたコードを何個もコピペしてやってみたのですが、なかなかうまく行きません。

詳しい方がおりましたら、コードを教えて頂けると助かります。
どうぞ、宜しくお願い致します。

回答No.2

FEX2053 · ベストアンサー

実証出来る環境に移動出来たので、実証してみました（苦笑）
したらば、案の定コードのミスが2か所。Offset(1)が抜けていたことと
PasteSpecialはPasteとは違って、Selectionで動くこと・・・です。

ま、それを直したのがこれですが。

Sheets("必要数").activate
CHK = Range("C2").Value
Range("C2:C50").copy

Sheets("出荷数").activate
Range("A65536").End(xlUp).Offset(1).Select

IF Selection.Offset(-1).Value<>CHK Then
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
　　Msgbox "日付が重複しています"
End If

ところで、当然こいつを動かすには前提条件とコピー先シートの準備が
必要です。あまりVBAに慣れていないようなので、コードの解説をしつつ。

まずは

Sheets("必要数").activate
CHK = Range("C2").Value

これで、必要数シートのC2:C50セルの先頭データを変数として取り込みます。
変数名は仮に「CHK」としましたが、これは私の癖で「日付」とかでもいいです。

Range("C2:C50").copy

これでコピーの準備をします。

Sheets("出荷数").activate
Range("A65536").End(xlUp).Offset(1).Select

これは「件数が判らない時の最終行の求め方の定番コード」です。End(xlUp)で
[Ctrl]+[↑]と同じ動きをします。要は「一番下の行から続いている空白の、一番
上のセルに飛ぶ」という処理になります。
http://www.happy2-island.com/excelsmile/smile03/capter00702.shtml

次に

IF Selection.Offset(-1).Value<>CHK Then

これで、一番上の空白のもう一つ上のセル＝データの入ってる最終セルを見に
行きます。これが、事前に保管しておいた変数の内容とあっているかチェックする
訳ですね。

当然このことから、コピーする先のシートには、事前に最低でもA1セルに何か
入ってないとエラーする（A1セルに飛んじゃうと、Offset(-1)に当たるセルが存在
しない）ということも判ります。

で、

Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

これで「行列を入れ替えて値貼り付け」というわけです。

ちなみに、これだけだと、処理は1回しか動きません。

複数回動かすには、例えばDo～Loopとかして、コピー元を順次変えていくという
ようなコードも必要ですが・・・それは大丈夫なんですよね？

お礼

アドバイスを頂きありがとうございます。
実際に動かしてみました。今の自分にはこれで十分だと思います。
また、わからない事がありましたら、質問させていただきたいと思いますので
その時は、宜しくお願い致します。
本当に、ありがとうございました。

補足

ご丁寧にありがとうございます。ＬＯＯＰさせないといけないのは、わかっているのですが、
どこで使えばいいのかわかりません。親切丁寧に教えて頂ける方なので、ご面倒でなければ
教えていただけますでしょうか？　宜しくお願い致します。

回答No.1

FEX2053

チェックしてないので、そのまま動くかどうかは分かりませんが、
発想としてはこれで行ける筈です。

Sheets("必要数").activate
CHK = Range("C2").Value
Range("C2:C50").copy

Sheets("出荷数").activate
Range("A65536").End(xlUp).Select

IF Selection.Offset(-1).Value<>CHK Then
　　Activesheet.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
　　Msgbox "日付が重複しています"
End If

要は事前に「チェックすべきセルの値を変数として受け取り、
IF文で、貼りつけるベく選択したセルの一つ上をチェックして
やる・・・って方法です。

変数でデータを受けて、後でどこかで使うという方法、
選んだセルを基準として、そこから「何個目」というセルの値を
得る方法が判れば、多分出来る話ではないかと思います。

補足

丁寧にコードを書いて頂きありがとうございます。
実際にエクセルに貼り付けてやってみましたが、うまく行きません。。

貼り付けの部分が、エラーになってしまったので、自分でやってみた
貼り付けのコード（ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=True
を書いてみて、実行すると、貼り付ける事はできたのですが
エラーメッセージもでず、貼り付けした次の行にもコピーされません。。。

Range("A65536").End(xlUp).Select

このコードが何か関係してるでしょうか・・？

お手数ですが、わかる方がおりましたら、教えてください。