select多个单元格并按下delete / backspace时出错

我有以下代码。 当按下[G，g，Y，y，R，r]时，它会执行一些操作，并且在按下其他按键时也会出现error handling。 这工作正常！ 但是，如果select第11列中的多个单元格并按下删除/退格键，则会出现“运行时错误”13：types不匹配“。

Private Sub Worksheet_Change(ByVal Target As Range) Dim TestCell Dim RE As Object Dim REMatches As Object Dim Cell1_1 As String Dim Today As String Dim Cell As String ThisRow = Target.Row 'Action happens when typing [G,g,Y,y,R,r] If Target.Column = 11 Then Set RE = CreateObject("vbscript.regexp") With RE .MultiLine = False .Global = False .IgnoreCase = True .Pattern = "[G,g,Y,y,R,r]" End With For Each TestCell In Target.Cells Set REMatches = RE.Execute(TestCell.Value) If REMatches.Count > 0 And Len(Target.Value) = 1 Then If Len(Cells(1, 1).Value) = 1 Then Today = Now() Cell1_1 = Sheets("Input").Cells(1, 1).Value Range("L" & ThisRow) = Cell1_1 + ": " + Format(Today, "ddmmmyy") End If 'Avoid typing another thing ElseIf Target.Value <> vbNullString Then Row = Target.Row Cells(Row, 11).Value = vbNullString MsgBox "Please, type only:" & vbNewLine & vbNewLine & "G for Green" & vbNewLine & "Y for Yellow" & vbNewLine & "R for Red" End If Next End If End Sub 

错误发生在代码中的这一行。

 If REMatches.Count > 0 And Len(Target.Value) = 1 Then 

Answer 1

如果没有丢失的function，您可以将该代码放在一些error handling中。

 Private Sub Worksheet_Change(ByVal Target As Range) Dim TestCell Dim RE As Object Dim REMatches As Object Dim Cell1_1 As String Dim Today As String Dim Cell As String ThisRow = Target.Row 'Action happens when typing [G,g,Y,y,R,r] If Target.Column = 11 Then Set RE = CreateObject("vbscript.regexp") With RE .MultiLine = False .Global = False .IgnoreCase = True .Pattern = "[G,g,Y,y,R,r]" End With For Each TestCell In Target.Cells Set REMatches = RE.Execute(TestCell.Value) On Error Goto Skip '************Error Handle************* If REMatches.Count > 0 And Len(Target.Value) = 1 Then If Len(Cells(1, 1).Value) = 1 Then Today = Now() Cell1_1 = Sheets("Input").Cells(1, 1).Value Range("L" & ThisRow) = Cell1_1 + ": " + Format(Today, "ddmmmyy") End If 'Avoid typing another thing ElseIf Target.Value <> vbNullString Then Row = Target.Row Cells(Row, 11).Value = vbNullString MsgBox "Please, type only:" & vbNewLine & vbNewLine & "G for Green" & vbNewLine & "Y for Yellow" & vbNewLine & "R for Red" End If Skip: '************Error Handle************* On Error goto 0 '************Error Handle************* Next End If End Sub 

或者如果代码仍然需要执行

 Private Sub Worksheet_Change(ByVal Target As Range) Dim TestCell Dim RE As Object Dim REMatches As Object Dim Cell1_1 As String Dim Today As String Dim Cell As String ThisRow = Target.Row 'Action happens when typing [G,g,Y,y,R,r] If Target.Column = 11 Then Set RE = CreateObject("vbscript.regexp") With RE .MultiLine = False .Global = False .IgnoreCase = True .Pattern = "[G,g,Y,y,R,r]" End With For Each TestCell In Target.Cells Set REMatches = RE.Execute(TestCell.Value) On Error Resume Next '************Error Handle************* If REMatches.Count > 0 And Len(Target.Value) = 1 Then If Len(Cells(1, 1).Value) = 1 Then Today = Now() Cell1_1 = Sheets("Input").Cells(1, 1).Value Range("L" & ThisRow) = Cell1_1 + ": " + Format(Today, "ddmmmyy") End If 'Avoid typing another thing ElseIf Target.Value <> vbNullString Then Row = Target.Row Cells(Row, 11).Value = vbNullString MsgBox "Please, type only:" & vbNewLine & vbNewLine & "G for Green" & vbNewLine & "Y for Yellow" & vbNewLine & "R for Red" End If On Error goto 0 '************Error Handle************* Next End If End Sub