excel - 如何修复 ExcelVBA 错误中的自动大写

Question

我在使用 VBA 方面仍然很陌生，所以我的许多代码只是从我学到的东西或我在搜索其他人如何做事时发现的东西拼凑而成。

下面的代码不断给我

“运行时错误 '13，类型不匹配”

基本上，它是一个缺席表单，如果输入了某些代码，它会通过评论框提示用户。我添加了一个按钮来删除所有代码和评论，但是当按下按钮时，它给了我上面的错误，有问题的行是：.Value = UCase(.Value)。我有这部分，因为我希望输入的所有代码都大写。

完整代码如下：

Private Sub CommandButton1_Click()

Range("C7:AG106").Value = ""

    Dim ws As Worksheet
    Dim cmt As Comment
    For Each ws In ActiveWorkbook.Worksheets
        For Each cmt In ws.Comments
            cmt.Delete
        Next cmt
    Next ws

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
    With Target
        Set isect = Application.Intersect(Target, Range("C7:AG106"))

                If Not (Application.Intersect(Target, Range("C7:AG106")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If

        If Not isect Is Nothing Then
            If .Text = "U" Then
                On Error GoTo AlreadyHasComment
                .AddComment
                On Error GoTo 0
                .Comment.Visible = True
                .Comment.Text Text:="Explain Unexcused Absense: "
            End If

            If .Text = "E" Then
                On Error GoTo AlreadyHasComment
                .AddComment
                On Error GoTo 0
                .Comment.Visible = True
                .Comment.Text Text:="Explain Excused Absense: "
            End If

            If .Text = "L" Then
                On Error GoTo AlreadyHasComment
                .AddComment
                On Error GoTo 0
                .Comment.Visible = True
                .Comment.Text Text:="Explain Late: "
            End If

            If .Text = "T" Then
                On Error GoTo AlreadyHasComment
                .AddComment
                On Error GoTo 0
                .Comment.Visible = True
                .Comment.Text Text:="Explain Tardy: "
            End If

        End If

    End With

    Exit Sub

AlreadyHasComment:
    ' Do something here, or not.

End Sub

标签： excelvba

Answer 1

请注意，它Target可以是一个范围（多个单元格），然后Target.Value是一个值数组，而不是单个值。这意味着.Value = UCase(.Value)不起作用，您必须通过循环使用UCase每个单元格。Target

' get all cells that changed and are within C7:AG106
Dim AffectedCells As Range
Set AffectedCells = Application.Intersect(Target, Me.Range("C7:AG106"))

If Not AffectedCells Is Nothing Then
    Dim iCell As Range
    For Each iCell In AffectedCells 'loop through that cells and handle each cell on it's own
        With iCell
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If

            'you need to include your other If statements here …

        End With
    Next iCell
End If

'and your error handlers go here …

---

最后它应该看起来像这样：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim AffectedCells As Range
    Set AffectedCells = Application.Intersect(Target, Me.Range("C7:AG106"))

    If Not AffectedCells Is Nothing Then
        Dim iCell As Range
        For Each iCell In AffectedCells
            With iCell
                If Not .HasFormula Then
                    Application.EnableEvents = False
                    .Value = UCase(.Value)
                    Application.EnableEvents = True
                End If

                If .Text = "U" Then
                    On Error GoTo AlreadyHasComment
                    .AddComment
                    On Error GoTo 0
                    .Comment.Visible = True
                    .Comment.Text Text:="Explain Unexcused Absense: "
                End If

                If .Text = "E" Then
                    On Error GoTo AlreadyHasComment
                    .AddComment
                    On Error GoTo 0
                    .Comment.Visible = True
                    .Comment.Text Text:="Explain Excused Absense: "
                End If

                If .Text = "L" Then
                    On Error GoTo AlreadyHasComment
                    .AddComment
                    On Error GoTo 0
                    .Comment.Visible = True
                    .Comment.Text Text:="Explain Late: "
                End If

                If .Text = "T" Then
                    On Error GoTo AlreadyHasComment
                    .AddComment
                    On Error GoTo 0
                    .Comment.Visible = True
                    .Comment.Text Text:="Explain Tardy: "
                End If
            End With
        Next iCell
    End If

    Exit Sub

AlreadyHasComment:
    ' Do something here, or not.
    Return

End Sub