完全一致したら複数のセル代入するマクロは？

質問

エクセルのSheet1のa列にある文字列と、Sheet2にあるa列にある文字列と完全一致したら、前者のセルの右隣から３番目までのセルに、後者のセルの右隣から３番目までの文字列を順に代入するマクロをお教えください。単純にvlookup関数を使えばいいのですが、ＶＢＡで行いたいのです。複数のセルに順に代入するのに苦慮しています。よろしくお願い申し上げます。

回答No.1

KURUMITO · ベストアンサー

例えば次のようなVBAにします。

Sub 試験()

Dim Row1 As Integer
Dim Coln1 As Integer
Dim Row2 As Integer
Dim Coln2 As Integer
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
Coln1 = 1
Coln2 = 1
For Row1 = 1 To WS1.Cells(Rows.Count, 1).End(xlUp).Row
For Row2 = 1 To WS2.Cells(Rows.Count, 1).End(xlUp).Row
If WS2.Cells(Row2, 1) = WS1.Cells(Row1, 1) Then
Do
Coln1 = Coln1 + 1
Coln2 = Coln2 + 1
WS1.Cells(Row1, Coln1) = WS2.Cells(Row2, Coln2)
Loop Until Coln1 = 4
Coln1 = 1
Coln2 = 1
End If
Next Row2
Next Row1

End Sub

お礼

完璧な回答ありがとうございます。これでうまくいきました。すばらしいの一言です！とくに完全一致したセルの右隣に代入するセルを任意のセルまでに引き延ばしたい場合、このコードのLoop Until Coln1 = 4の右辺の数字を変えればいいのですね。早速の回答と、完璧な回答に感謝申し上げます。