| |
こんにちは
こんな感じかな？
（Sheet1=表1 ・ Sheet2=表2）と仮定しています。
Sub Test_1()
Dim C As Range, Fi As Range, R As Range
Dim Ws As Worksheet, Ad As String
Set Ws = Worksheets("Sheet2")
With Worksheets("Sheet1")
Set R = .Range("A2", .Range("A65536").End(xlUp))
For Each C In R
Set Fi = Ws.Columns(1).Find(C.Value, , xlValues, xlWhole)
If Not Fi Is Nothing Then
Ad = Fi.Address
Do
Set Fi = Ws.Columns(1).Find(Fi)
If Fi.Offset(, 1).Value = C.Offset(, 1).Value Then
C.Offset(, 255).Value = 1
'一致した場合の処理コード
End If
Loop Until Ad = Fi.Address
End If
Set Fi = Nothing
Next C
On Error GoTo End_Len
R.Offset(, 255).SpecialCells(xlCellTypeBlanks).EntireRow.Copy _
Ws.Range("A65536").End(xlUp).Offset(1)
On Error GoTo 0
Ws.Columns(256).Clear
R.Offset(, 255).Clear
End With
End_Len:
Set R = Nothing: Set Ws = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/4/17(月) 13:38 -
