|
▼まっつん さん:
こんにちは。
ディクショナリでしてみました。
Sub TEST()
Dim Dic As Object
Dim vA As Variant
Dim vD1 As Variant
Dim vD2 As Variant
Dim i As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
vA = .Range("A2:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("Sheet2")
vD1 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
With Worksheets("Sheet3")
vD2 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With
For i = 1 To UBound(vA)
Dic(vA(i, 2)) = i
Next
For i = 1 To UBound(vD1)
If Dic.Exists(vD1(i, 1)) Then
vA(Dic(vD1(i, 1)), 1) = i + 1 & "-A"
End If
Next
For i = 1 To UBound(vD2)
If Dic.Exists(vD2(i, 1)) Then
If vA(Dic(vD2(i, 1)), 1) = "" Then
vA(Dic(vD2(i, 1)), 1) = i + 1 & "-B"
Else
vA(Dic(vD2(i, 1)), 1) = _
vA(Dic(vD2(i, 1)), 1) & "/" & i + 1 & "-B"
'AとBの行番号が違う
'vA(Dic(vD2(i, 1)), 1) & "/B" '質問通りだったら入れ替え
End If
End If
Next
Set Dic = Nothing
With Worksheets("Sheet1")
.Columns(1).ClearContents
.Range("A2").Resize(UBound(vA)).Value = vA
End With
End Sub
|
|