|
▼たつ さん:
こんにちは。おじゃまします。
(Windows 7 にアップグレードして はじめてのレスです)
遡及する案がたくさん出ていますが、
単純に上から削除アイテム追加して削除行にチェックしていったとき、
どんな不具合が出短でしたっけ?
再度 ↓で検証してみていただけませんか?
Sub Try1()
Dim dic As Object
Dim c As Range
Set dic = CreateObject("Scripting.Dictionary")
'[Sheet2] 削除リスト取得
With Worksheets("Sheet2")
For Each c In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
dic(c.Value) = Empty
Next
End With
Dim r As Range
Dim v, u, i As Long, ss As String
With Worksheets("Sheet1")
Set r = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
v = r.Resize(, 2).Value
With r.Columns(3)
.ClearContents
u = .Value
End With
For i = 1 To UBound(v) 'A列を上から順に調べる(遡及チェックなし)
If dic.Exists(v(i, 1)) Then
u(i, 1) = "←削除"
ss = v(i, 2)
If ss Like "CA*" Then ss = Mid$(ss, 3)
dic(ss) = Empty
End If
Next
With r.Columns(3)
.Value = u
'.specialcells(xlconstants).entirerow.delete
End With
End With
Set dic = Nothing
End Sub
|
|