|
Sub Test_Match()
Dim MyR As Range, C As Range
Dim CkS As String
Dim x As Variant
Dim Ary1() As Variant, Ary2() As Variant
Dim i As Long
With Sheets("B")
With .Range("B2", .Range("B65536").End(xlUp)).Offset(, 26)
.Formula = "=$B2&$C2"
.Value = .Value
End With
End With
With Sheets("A")
Set MyR = .Range("A2", .Range("A65536").End(xlUp))
End With
For Each C In MyR
CkS = C.Value & C.Offset(, 1).Value
x = Application.Match(CkS, Sheets("B").Range("AB:AB"), 0)
If IsError(x) Then
ReDim Preserve Ary1(i): ReDim Preserve Ary2(i)
Ary1(i) = C.Value, Ary2(i) = C.Offset(, 1).Value
i = i + 1
End If
Next
If i = 0 Then
MsgBox "Bシート に見つからないデータはありません", 48
Set MyR = Nothing: Exit Sub
End If
With WorksheetFunction
Ary1 = .Transpose(Ary1)
Ary2 = .Transpose(Ary2)
End With
With Sheets("B")
With .Range("B65536").End(xlUp)
.Offset(1).Resize(UBound(Ary1) + 1).Value = Ary1
.Offset(1, 1).Resize(UBound(Ary2) + 1).Value = Ary2
End With
.Range("AB:AB").ClearContents
.Activate
End With
Set MyR = Nothing: Erase Ary1, Ary2
End Sub
で、どうかな・・?
|
|