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

更新;为了尝试解决速度问题并选择不同的表格，我在代码中添加了一些复杂性...... 宏现在将格式化工作表中的选定范围（您应该可以根据需要改变它...）

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

如何使用if语句删除行

1 个答案: