Vba 如何使用if语句删除行

我的电子表格中有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

---

我非常感谢你的帮助。谢谢你

像这样的东西应该有用

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

---

更新；为了解决速度问题和选择不同的工作表，我给代码增加了一些复杂性。。。 宏现在将格式化工作表中的选定范围（希望您能够根据需要对其进行更改…）

子维护日期行（）
工作表（“工作表1”）。激活
调用KeepDateRowsAndFormat（列（“C:F”））
端接头
函数KeepDateRowsAndFormat（搜索区域作为范围）
Application.ScreenUpdating=False
作为整数的Dim i，j
将标志变暗为布尔值
将第一个地址设置为字符串
出错时继续下一步
将FirstCol的长度设置为：FirstCol=SearchArea.Find（“*”，LookIn:=xlValues_
SearchOrder:=xlByColumns，SearchDirection:=xlNext）.Column
将LastCol的长度设置为：LastCol=SearchArea.Find（“*”，LookIn:=xlValues_
SearchOrder:=xlByColumns，SearchDirection:=xlPrevious）.Column
将FirstRow的长度设置为：FirstRow=SearchArea.Find（“*”，LookIn:=xlValues_
搜索顺序：=xlByRows，搜索方向：=xlNext）。行
将LastRow的长度设置为：LastRow=SearchArea.Find（“*”，LookIn:=xlValues_
搜索顺序：=xlByRows，搜索方向：=xlPrevious）。行
如果LastRow=0，则退出函数
错误转到0
将搜索区域变暗为范围
设置RealSearchArea=范围（单元格（第一行，第一列），单元格（最后行，最后列））
'格式化日期单元格
Application.FindFormat.NumberFormat=“m/d/yyyy”
带RealSearchArea
.激活
变暗Rng As范围
设置Rng=.Find（“*”，LookIn:=xlValues，After:=ActiveCell，LookAt:=xlPart_
SearchOrder:=xlByRows，SearchDirection:=xlNext，SearchFormat:=True）
如果不是，那么Rng什么都不是
FirstAddress=Rng.Address
做
Rng.Interior.ColorIndex=7
设置Rng=.FindNext（Rng）
非Rng时循环为Nothing，Rng.Address为FirstAddress
如果结束
以
'删除非日期行
对于i=最后一行到第一行步骤-1
flag=False
j=第一列
做
如果IsDate（单元格（i，j）.Value）=True，则flag=True
j=j+1
Loop While flag=False和j非常感谢，宏可以工作，但有点慢。你知道有什么方法可以让它更快吗？@user7004:如果代码有效，你可能应该接受答案。我认为速度慢可能是因为你没有10000行。您可以尝试查找范围中最后一行的索引，然后仅在这些行上运行子行。您也可以尝试将“IsDate”更改为“Format（ddmmyyy）”，但这又取决于您自己。使代码运行更快的一种快速方法是关闭屏幕刷新。宏运行时，屏幕将保持静态，直到完成。只需在开头加上“False”，在结尾加上“True”（就在end Sub之前）：
Application.screenUpdate=False
非常感谢。我想做同样的过程，但在另一个电子表格，我如何写这个？我试着用工作表（“sheet2”）来表示“工作”，然后以结束，但它不起作用
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