Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

46602 / 76732

←次へ　｜　前へ→


	【35100】Re:VLOOKUP関数をVBAで使うにはどうした...

Kein - 06/2/21(火) 13:35 -


	引用なし

	パスワード

速度を期待することは出来ませが、ロジックとしては

Sub Test_Calc2()
　 Dim Sh As Worksheet, Sh2 As Worksheet
　 Dim MyR As Range, C As Range
　 Dim Ck As Variant

　 Set Sh = Worksheets("Sheet1")
　 Set Sh2 = Worksheets("Sheet2")
　 On Error GoTo ELine
　 Set MyR = Sh.Range("B:B").SpecialCells(2)
　 On Error GoTo 0
　 For Each C In Sh2.Range("A1", Sh2.Range("A65536").End(xlUp))
　　　Ck = Application.Match(C.Value, Sh.Range("A:A"), 0)
　　　If Not IsError(Ck) Then
　　　　 If Not Intersect(Sh.Cells(Ck, 2), MyR) Is Nothing Then
　　　　　　 C.Offset(, 1).Value = Sh.Cells(Ck, 2).Value
　　　　 End If
　　　End If
　 Next
ELine:
　 Set MyR = Nothing: Set Sh = Nothing: Set Sh2 = Nothing
End Sub

あるいは、検索元と検索先を逆にすることが可能なら

Sub Test_Calc3()
　 Dim Sh As Worksheet, Sh2 As Worksheet
　 Dim MyR As Range, C As Range
　 Dim Ck As Variant

　 Set Sh = Worksheets("Sheet1")
　 Set Sh2 = Worksheets("Sheet2")
　 On Error GoTo ELine
　 Set MyR = Sh.Range("B:B").SpecialCells(2)
　 On Error GoTo 0
　 For Each C In MyR
　　　Ck = Application _
　　　.Match(C.Offset(, -1).Value, Sh2.Range("A:A"), 0)
　　　If Not IsError(Ck) Then
　　　　Sh2.Cells(Ck, 2).Value = C.Value
　　　End If
　 Next
ELine:
　 Set MyR = Nothing: Set Sh = Nothing: Set Sh2 = Nothing
End Sub

というコードも考えられます。

11 hits

▼

【35054】VLOOKUP関数をVBAで使うにはどうしたらい... ぷうたろう 06/2/20(月) 13:43