|
▼たつ さん:
興味がわいたので作ってみました。
削除すべき行の3列目に"○"印を付けるようにしています。
考え方はこれであっていますか?
合っていればEr内の整列と、下の行からの削除というように
改造する方法はいかがでしょうか。
Option Explicit
Sub test()
Dim i As Long, j As Long, k As Long
Dim r2 As Long, r1 As Long
Dim dat As Variant, Er As Variant
'削除対象読み込み
With Worksheets("Sheet2")
r2 = .Range("A" & Rows.Count).End(xlUp).Row
ReDim dat(1 To r2)
For i = 1 To r2
dat(i) = .Cells(i, 1).Value
Next i
End With
With Worksheets("Sheet1")
r1 = .Range("A" & Rows.Count).End(xlUp).Row
ReDim Er(1 To 1)
Do
k = 0
For i = 1 To r1
If InStr(vbTab & Join(dat, vbTab) & vbTab, _
vbTab & .Cells(i, 1).Value & vbTab) > 0 Then
If InStr(vbTab & Join(Er, vbTab) & vbTab, _
vbTab & i & vbTab) = 0 Then
If Er(UBound(Er)) <> "" Then
ReDim Preserve Er(1 To UBound(Er) + 1)
End If
Er(UBound(Er)) = i
End If
For j = 1 To UBound(dat)
If InStr(vbTab & Join(dat, vbTab) & vbTab, _
vbTab & .Cells(i, 2).Value & vbTab) = 0 Then
If dat(UBound(dat)) <> "" Then
ReDim Preserve dat(1 To UBound(dat) + 1)
End If
dat(UBound(dat)) = .Cells(i, 2).Value
k = 1
End If
Next j
Else
End If
Next i
Loop While k = 1
For i = 1 To UBound(Er)
.Cells(Er(i), 3).Value = "○"
Next i
End With
End Sub
|
|