私のコードは j 列でいくつかの値を探し、それらが見つかった場合は列 1 から 11 の間の行を削除することになっています。 「セット c = .FindNext(c)」に。どうしたの?ありがとう!!!
Sub ExcluirGraosIncompletos()
Application.ScreenUpdating = False
Dim c As Range
Dim ClearAddress As String
Dim ClearRow As Long
With Worksheets("ListBCOGJ").Range("J4:J17780")
Set c = .Find(What:=6, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=5, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=42, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=66, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=36, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=1, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=4, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=2, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=27, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
Set c = .Find(What:=60, LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=True)
If Not c Is Nothing Then
ClearAddress = c.Address
Do
ClearRow = c.Row
Range(Cells(ClearRow, 1), Cells(ClearRow, 11)).Delete Shift:=xlUp
Set c = .FindNext(c)
Loop While c.Address <> ClearAddress
End If
End With
Application.CutCopyMode = False
Range("A1").Select
Application.ScreenUpdating = True
End Sub