使用VBA在Excel中删除特定年份的某个月份

时间:2014-05-12 08:52:46

标签: excel vba excel-vba

我正在创建宏,它将遍历F列并将从2013年4月删除。似乎宏正在删除所有:-D。我不知道如何将其设置为仅删除我尝试(Month(Now) - 2)的条件。我的格式日期看起来像DD/MM/YYYY

感谢您的帮助。

Sub Test1()

    Dim rgFoundCell As Range
    Dim toBeDeted As Range
    Dim firstAddress

    With Sheets("Sheet1").Range("F:F")
        Set rgFoundCell = .Find(What:=(Month(Now) - 2))

        If Not rgFoundCell Is Nothing Then
            firstAddress = rgFoundCell.Address

            Do
                If toBeDeted Is Nothing Then
                    Set toBeDeted = rgFoundCell.EntireRow
                Else
                    Set toBeDeted = Union(toBeDeted, rgFoundCell.EntireRow)
                End If

                Set rgFoundCell = .FindNext(rgFoundCell)
                If rgFoundCell Is Nothing Then Exit Do

            Loop While rgFoundCell.Address <> firstAddress

        End If
    End With

    Application.ScreenUpdating = True

    If Not toBeDeted Is Nothing Then _
        toBeDeted.Delete ' Delete


End Sub

2 个答案:

答案 0 :(得分:2)

你不能以你的思维方式使用.Find - 它只能进行文本匹配或数字匹配比较。这使您不得不循环遍历范围中的每个单元格并在每个单元格上显式运行比较

Sub Test1()

    Dim toBeDeleted As Range

    With Sheets("Sheet1").Range("F:F")
        For Each c In .Cells
            If Month(c.Value) = 3 And Year(c.Value) = 2013 Then                
                If toBeDeleted Is Nothing Then
                    Set toBeDeleted = c.EntireRow
                Else
                    Set toBeDeleted = Union(toBeDeleted, c.EntireRow)
                End If
            End If
        Next
    End With

    If Not toBeDeleted Is Nothing Then _
        toBeDeleted.Delete ' Delete

End Sub

您可能需要考虑在比完整F列更精细的范围上运行该函数,或者使用数据结束标记,例如检查空行以停止循环。

答案 1 :(得分:1)

试试这个:

Sub Test1()
    On Error GoTo e
    Application.ScreenUpdating = False
    Dim rng As Range
    Dim firstAddress

    Set rng = Sheets("Sheet1").Range("F1", Sheets("Sheet1").Range("F1").End(xlDown))
    Dim i As Long
    i = 1
    While i <= rng.Count
        If Month(CDate(rng(i))) = 4 And Year(CDate(rng(i))) = 2014 Then
            rng (i).EntireRow.Delete
        Else
            i = i + 1
        End If
    Wend
x:
    Application.ScreenUpdating = True
    Exit Sub
e:
    MsgBox (Err.Description)
    Resume x
End Sub

也许尝试减少F:F范围!!!