Как удалить строки, используя оператор if

Question

У меня есть диапазон из 3 столбцов в моей таблице, которые нужно удалить с помощью оператора if.

В принципе, если он показывает дату в любом из этих столбцов, я должен поддерживать их, если не удалять. Важно подчеркнуть, что я не могу удалить строки, которые имеют дату в одном столбце, но не имеют в другом, если есть дата в любом из них, я должен поддерживать строки.

Я попытался написать следующий код, но я имею проблемы

Sub maintain_only_dates() 
    Set Rng = Range("b1:D10000") 
    If Rng = Format("ddmmyyyy") Then 
     Cell.Interior.ColorIndex = 7 
    Else 
     Range("A:A").EntireRow.Delete 
    End If 
End Sub 

Я очень ценю вашу помощь. Спасибо

Answer 1

Что-то вроде этого должно работать ...

Sub MaintainDateRows() 

    Dim i As Integer 
    For i = 10000 To 1 Step -1 
     If IsDate(Cells(i, 2).Value) Or IsDate(Cells(i, 3).Value) Or _ 
      IsDate(Cells(i, 4).Value) Then 
      If IsDate(Cells(i, 2).Value) Then Cells(i, 2).Interior.ColorIndex = 7 
      If IsDate(Cells(i, 3).Value) Then Cells(i, 3).Interior.ColorIndex = 7 
      If IsDate(Cells(i, 4).Value) Then Cells(i, 4).Interior.ColorIndex = 7 
     Else 
      Rows(i).EntireRow.Delete 
     End If 
    Next i 
End Sub 

---

Update; Чтобы попытаться решить проблемы с производительностью и выбрать разные листы, я добавил некоторую сложность в код ... Теперь макрос будет отформатировать выбранный диапазон на листе (вы, надеюсь, сможете изменить его по вашим потребностям ...)

Sub MaintainDateRows() 

    Sheets("Sheet1").Activate 
    Call KeepDateRowsAndFormat(Columns("C:F")) 

End Sub 

Function KeepDateRowsAndFormat(SearchArea As Range) 

    Application.ScreenUpdating = False 

    Dim i, j As Integer 
    Dim flag As Boolean 
    Dim FirstAddress As String 

    On Error Resume Next 
    Dim FirstCol As Long: FirstCol = SearchArea.Find("*", LookIn:=xlValues, _ 
     SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column 
    Dim LastCol As Long: LastCol = SearchArea.Find("*", LookIn:=xlValues, _ 
     SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
    Dim FirstRow As Long: FirstRow = SearchArea.Find("*", LookIn:=xlValues, _ 
     SearchOrder:=xlByRows, SearchDirection:=xlNext).Row 
    Dim LastRow As Long: LastRow = SearchArea.Find("*", LookIn:=xlValues, _ 
     SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    If LastRow = 0 Then Exit Function 
    On Error GoTo 0 

    Dim RealSearchArea As Range 
    Set RealSearchArea = Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol)) 

    ' Format Date Cells 
    Application.FindFormat.NumberFormat = "m/d/yyyy" 
    With RealSearchArea 
     .Activate 
     Dim Rng As Range 
     Set Rng = .Find("*", LookIn:=xlValues, After:=ActiveCell, LookAt:=xlPart, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True) 
     If Not Rng Is Nothing Then 
      FirstAddress = Rng.Address 
      Do 
       Rng.Interior.ColorIndex = 7 
       Set Rng = .FindNext(Rng) 
      Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
     End If 
    End With 

    ' Remove Non Date Rows 
    For i = LastRow To FirstRow Step -1 
     flag = False 
     j = FirstCol 
     Do 
      If IsDate(Cells(i, j).Value) = True Then flag = True 
      j = j + 1 
     Loop While flag = False And j <= LastCol 
     If flag = False Then Rows(i).EntireRow.Delete 
    Next i 

    Application.ScreenUpdating = True 

End Function