Question

我有以下代码。当按下特定的[G，g，Y，y，R，r]并且在按下其他键的情况下存在错误处理时，它会执行一些操作。这很好用！但是，当选择第11列中的多个单元格并按下删除/退格键时，我得到＆＃34;运行时错误＆＃39; 13＆＃39;：类型不匹配＆＃34;。

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

如果没有丢失的功能，您可以将该代码包含在某些错误处理中。

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

选择多个单元格时出错并按删除/退格

1 个答案: