0

私のコードは 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
4

1 に答える 1