Как исправить автокапитализацию в 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

Answer 1

Обратите внимание, что Target может быть диапазоном (несколько ячеек), тогда Target.Value - это массив значений, а не одно значение. Это означает, что .Value = UCase(.Value) не работает, и вы должны использовать UCase для каждой ячейки Target, используя al oop.

' 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