Excel VBAmacros删除行无限循环

我有一个VBAmacros,旨在为用户自动格式化指定范围的单元格,并且这样做是正确的。 但是,当用户试图删除指定范围内的行时,它会触发我内置的错误消息为无限循环。

代码如下所示:

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 

用户坚持认为他们需要删除数据行而不将这个macros发送到循环中。 我怎样才能修改我在这里允许这种情况呢?

(我清楚地修改了代码,留下了很多,我不觉得这是必要的,并阻止我的post成为页面和页面。

而不是这个:

 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