Excel:VBA-改行して同じ動作を繰り返すには

質問

VBAで下記の動作を実現させたいのですが、もう一歩のところで上手くいきません。
アドバイスを宜しくお願いします。

・C列が空欄になるまで、AD列を改行させて同じ作業を繰り返す。

Do Loopステートメントで下記のように作ってみたのですが、"AD2"から"AD3"に改行させることが
出来ないのです。
------------------------------------
Sub 棚番2()

Range("C2").Activate
Do Until ActiveCell.Value = ""
Range("AD2").FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-27],棚番!C2:C3,2,0)),"""",VLOOKUP(RC[-27],棚番!　　　C2:C3,2,0))"
Range("AD2").Copy
Range("AD2").PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1).Activate
Loop
End Sub
---------------------------------

何卒アドバイスを下さいますよう宜しくお願いいたします。

回答No.2

jcctaira · ベストアンサー

「"AD2"から"AD3"に改行させることが…」分かりにくいですが、
多分「C2の検索結果をAD2」,「C3の検索結果をAD3」…としたいのだと推測します。
セルの変化させるには、CellsやOffsetを使用する方が便利です。
また、ActiveCellやコピー&ペーストを使用しない方がプログラムはすっきりすると思いますよ。
以下、サンプルマクロです。

Sub 棚番2()
　Dim I As Long
　For I = 2 To Rows.Count
　　If Cells(I, "C").Value = "" Then Exit For
　　Cells(I, "AD").FormulaR1C1 = _
　　　"=IF(ISERROR(VLOOKUP(RC[-27],棚番!C2:C3,2,0)),"""",VLOOKUP(RC[-27],棚番!C2:C3,2,0))"
　　Cells(I, "AD").Value = Cells(I, "AD").Value
　Next I
End Sub

お礼

判りづらい説明であるにも関わらずご対応頂き、どうもありがとうございます。
教えて下さった内容で、実現させたい動作を取ることができました！

大変助かりました。

コピー＆ペーストも今後は使用しなくても済むよう教えて下さった方法を活用します。

回答No.3

Wendy02

記録マクロでは、うまく行きません。
こういう時のマクロのパターンというのは、ある程度決まったものがありますが、最近は、あまりそういうパターンを使わない人のほうが多いようです。

Sub Planogram2()
'棚番2
Dim rng As Range
　　Set rng = Range("C2", Cells(Rows.Count, 3).End(xlUp))
　　With rng.Offset(, 27)
　　.Formula = _
　　"=IF(ISERROR(VLOOKUP(RC3,棚番!C2:C3,2,0)),"""",VLOOKUP(RC3,棚番!C2:C3,2,0))"
　　.Value = .Value
　　End With
End Sub

お礼

ご連絡どうもありがとうございます。
まだまだ勉強中で、記録マクロを頼ってしまっていますが、
やはり実現できることに限界がありますよね。

もっと勉強して知識を増やしていこうと思います。

回答No.1

kybo

やりたいことがよくわかりませんが、C2がアクティブセルの場合、AD2に数式を入れて値の貼り付け、C3がアクティブセルの場合、AD3に数式を入れて値の貼り付け・・としたいのであれば、AD3に数式を入れる部分がありません。

以下サンプルです。動作確認は全くしてません。

Sub 棚番2()

Range("C2").Activate
Do Until ActiveCell.Value = ""
Cells(ActiveCell.Row, "AD").FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-27],棚番!C2:C3,2,0)),"""",VLOOKUP(RC[-27],棚番!　　　C2:C3,2,0))"
Cells(ActiveCell.Row, "AD").Copy
Cells(ActiveCell.Row, "AD").PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1).Activate
Loop
End Sub

お礼

判りづらい説明にも関わらず、ご連絡下さりどうもありがとうございました。