Excel VBA宏删除行无限循环

Question

我有一个 VBA 宏，旨在为用户自动格式化指定范围的单元格，并且它正确地执行了此操作。但是，当用户尝试删除指定范围内的一行时，它会触发我作为无限循环内置的错误消息。

代码如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rTimeCells As Range

    Set rTimeCells = Range("D2:G15")

    Application.EnableEvents = False


    If Not Application.Intersect(rTimeCells, Range(Target.Address)) Is Nothing Then
            Call Time_Format(Range(Target.Address))
    End If

    Application.EnableEvents = True

    End Sub

    Private Sub Time_Format(rCells As Range)
    Dim RegEXFormat1 As Object
    ...
    Dim RegEXFormatX As Object

    Set RegEXFormat1 = CreateObject("VBScript.RegExp")    
    ...
    Set RegEXFormatX = CreateObject("VBScript.RegExp")


    RegEXFormat1.Global = True
    ...
    RegEXFormatX.Global = True


    RegEXFormat1.IgnoreCase = True
    ...
    RegEXFormatX.IgnoreCase = True

    RegEXFormat1.Pattern = "..."
    ...
    RegEXFormatX.Pattern = "..."


    For Each cell In rCells
        Dim sValue As String
        Dim sMonth As String
        Dim sDay As String
        Dim sYear As String
        Dim bCorrectFormat As Boolean

        bCorrectFormat = True
        sValue = CStr(cell.Text)

        If (RegEXFormat1.test(sValue)) Then
        ...
        ElseIF(RegEXFormatX.test(sValue) Then
        ...
        Else
            If (sValue = "" Or sValue = "<Input Date>") Then
            Else
                MsgBox ("Please Input the date in correct numeric format")
                cell.value = "<Input Date>"
        End If
    Next

用户坚持他们需要能够删除数据行而不将此宏发送到循环中。如何修改我在这里的内容以允许这种情况发生？

（我清楚地修改了代码并遗漏了很多我觉得这里没有必要的内容，并阻止我的帖子变得一页又一页。）

Answer 1

而不是这个：

If Not Application.Intersect(rTimeCells, Range(Target.Address)) Is Nothing Then
     Call Time_Format(Range(Target.Address))
End If

您可能希望使用以下方式限制传递给Time_Format 的范围：

Dim rngTime as Range
Set rngTime = Application.Intersect(rTimeCells, Target)
If Not rngTime Is Nothing Then
     Call Time_Format(rngTime)
End If

注意：Range(Target.Address) 等价于Target