セルに値が入力されると隣りのセルに数式を入力したい（VBA）

セルC3から最終行（LASTROWという変数に格納されています）までの間に
何らかの文字が入力されたら、隣り合うD列の同じ行に下記数式を入力させたいです。
=IFERROR(VLOOKUP(C3,THEMA!A:B,2,FALSE),"")
※上記数式内の「C3」は入力されたセルの行に応じて変更させたいです。
　例えばC5に文字が入力されたら、D5には=IFERROR(VLOOKUP(C5,THEMA!A:B,2,FALSE),"")

VBA初心者です。

ネットでセルに文字が入力されたら実行させるマクロ例を見て作ろうと思ったのですが、
下記？？？？部分にどのような構文を用いればいいのかわからず質問させて頂きました。
Private Sub Worksheet_Change(ByVal Target As Range)
LASTROW = Cells(Rows.Count, "A").End(xlUp).Row
If Target.Column = 3 Then
If Target.Row >= 3 And Target.Row <= LASTROW Then
？？？？
End If
End If
End Sub

VBA使うのであればわざわざVLOOKUP使わなくても・・・と言う場合は数式には
拘りありません。VLOOKUPと同等の処理ができればOKですのでその点もご教授
お願いいたします。

質問者からの補足コメント

• なお、一度入力した文字を消す時もあります。
  その時は隣のセルは空白にしたいです。

    補足日時：2019/07/15 18:22

No.4 ベストアンサー 回答者： tom04 回答日時： 2019/07/15 22:25

続けてお邪魔します。

結局、C・L列で同様の動きにしたい！というコトですね。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim lastRow As Long, c As Range
　　If Intersect(Target, Range("C:C,L:L")) Is Nothing Then Exit Sub
　　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　　　If Target.Count > 1000 Then Exit Sub
　　　　　For Each c In Target
　　　　　　With c
　　　　　　　If .Row > 2 And .Row <= lastRow Then
　　　　　　　　If .Value <> "" Then
　　　　　　　　　If .Column = 3 Then
　　　　　　　　　　.Offset(, 1).Formula = "=IFERROR(VLOOKUP(RC[-1],THEMA!C[-3]:C[-2],2,False),"""")"
　　　　　　　　　Else
　　　　　　　　　　.Offset(, 1).Formula = "L列の数式"
　　　　　　　　　End If
　　　　　　　　Else
　　　　　　　　　.Offset(, 1).ClearContents
　　　　　　　　End If
　　　　　　　End If
　　　　　　End With
　　　　　Next c
End Sub

※　L列の数式が判らないので
その部分はご自身で数式を入れてください。m(_ _)m

この回答へのお礼

ありがとうございました。
意図している対応ができました。
お手数おかけいたしました。

お礼日時：2019/07/16 09:51

No.3 回答者： tom04 回答日時： 2019/07/15 21:05

No.2です。

＞複数この処理を実施したい場合は・・・

C列複数セルに対応したい！というコトですね。
↓のコードに変更してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim lastRow As Long, c As Range
　　If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
　　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　　　For Each c In Target
　　　　　With c
　　　　　　If .Row > 2 And .Row <= lastRow Then
　　　　　　　If .Value <> "" Then
　　　　　　　　.Offset(, 1).Formula = "=IFERROR(VLOOKUP(RC[-1],THEMA!C[-3]:C[-2],2,False),"""")"
　　　　　　　Else
　　　　　　　　.Offset(, 1).ClearContents
　　　　　　　End If
　　　　　　End If
　　　　　End With
　　　　Next c
End Sub

※　注意点として
C列をループさせていますので、
極端に多くの行数（例えば列全体など）を一気に消去した場合などは
「応答なし」になってしまうと思います。

セル数の制限などを追加すれば大丈夫です。
たとえば1000セルに限定する場合は
＞lastRow = Cells(Rows.Count, "A").End(xlUp).Row
の次に

＞If Target.Count > 1000 Then Exit Sub
の1行を追加しておけば列全体を消去しても大丈夫だと思います。
ただ、この場合はD列は空白に見えても数式はそのまま残っています。m(_ _)m

この回答へのお礼

ありがとうざいます。
複数同時に消しても動作しました。

私の言葉足らずですみません。
C列以外（例えばL列）も同じように隣り合うセルに数式（数式は少し変わりますVLOOKUP参照の
シート名が異なる）を入力したい場合はどのように表記すれば良いかというのが№２へのコメントでした。
もしよろしければご教授頂けると助かります。

お礼日時：2019/07/15 21:58

No.2 回答者： tom04 回答日時： 2019/07/15 19:17

こんばんは！

今回の場合はR1C1形式の方が対応が簡単だと思います。
一例です。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim lastRow As Long
　　If Intersect(Target, Range("C:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　　lastRow = Cells(Rows.Count, "A").End(xlUp).Row
　　　　With Target
　　　　　If .Row > 2 And .Row <= lastRow Then
　　　　　　If .Value <> "" Then
　　　　　　　.Offset(, 1).Formula = "=IFERROR(VLOOKUP(RC[-1],THEMA!C[-3]:C[-2],2,False),"""")"
　　　　　　Else
　　　　　　　.Offset(, 1).ClearContents
　　　　　　End If
　　　　　End If
　　　　End With
End Sub

＞なお、一度入力した文字を消す時もあります。
＞その時は隣のセルは空白にしたいです。

というコトですが、数式そのものでで「空白」になりますが
とりあえず数式も消去するコードにしています。
（1セルずつ対応するコードのためにC列データを複数行を一気に消去しても対応していません。）

この回答へのお礼

ありがとうございました。
複数この処理を実施したい場合は下記のように追加していけば良いでしょうか？
二つ目のブロックでブレークしても止まらなかったのに処理されていたので心配になりました。
※文字数制限のため数式部分を＠＠にしてます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long
If Intersect(Target, Range("C:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Target
If .Row > 2 And .Row <= lastRow Then
If .Value <> "" Then
.Offset(, 1).Formula = "＠＠"
Else
.Offset(, 1).ClearContents
End If
End If
End With

If Intersect(Target, Range("L:L")) Is Nothing Or Target.Count > 1 Then Exit Sub
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Target
If .Row > 2 And .Row <= lastRow Then
If .Value <> "" Then
.Offset(, 1).Formula = "＠＠"
Else
.Offset(, 1).ClearContents
End If
End If
End With
End Sub

お礼日時：2019/07/15 20:42

No.1 回答者： fxq11011 回答日時： 2019/07/15 18:30

＞までの間に

その各行についてですね、その中のいずれかの行のセルに文字入力があれば、そのセルの隣のセルのみに数式を・・・・・と解釈します
文字入力する列はｃ列とすれば、となりのｄ列の各行に関数で処理すれば。
C4に、If（C３＝””,””,IFERROR(VLOOKUP(C5,THEMA!A:B,2,FALSE),"")）
ただし？、です。

この回答へのお礼

ありがとうございます。
説明不足すみません。
現状関数を埋め込んでいますが、行数が多いため関数を埋め込んでおくとファイルサイズが
大きくなるので関数を止めてマクロで処理したかったのです。

お礼日時：2019/07/15 18:39