|
コメントを待っていましたが、
平日は時間がとれないので、準備しておいたものを示しておきます。
参考にしてください。
Sub test1() '例示されたケースだけに有効
Dim r As Range
Dim v As Variant
For Each r In Range("A1", Range("A1").End(xlDown))
v = r.Value
Select Case v
Case Cells(1, "B").Value
v = Cells(1, "C").Value
Case Cells(2, "B").Value
v = Cells(2, "C").Value
End Select
r.Offset(0, 3).Value = v
Next
End Sub
Sub test2() ' 一般的なケースに適用可能
Dim r As Range
Dim m As Variant
For Each r In Range("A1", Range("A1").End(xlDown))
m = Application.Match(r, Columns("B"))
If Not IsError(m) Then
r.Offset(0, 3).Value = Cells(m, "C").Value
Else
r.Offset(0, 3).Value = r.Value
End If
Next
End Sub
Sub test3() ' 一般的なケースに適用可能
Dim dic As Object
Dim r As Range
Set dic = CreateObject("Scripting.Dictionary")
For Each r In Range("B1", Range("B1").End(xlDown))
dic(r.Value) = r.Offset(0, 1).Value
Next
For Each r In Range("A1", Range("A1").End(xlDown))
If dic.exists(r.Value) Then
r.Offset(0, 3).Value = dic(r.Value)
Else
r.Offset(0, 3).Value = r.Value
End If
Next
End Sub
|
|