Макрос, чтобы заставить верхний регистр не работать в указанном диапазоне

Question

Мне нужен макрос в Excel, чтобы автоматически использовать заглавные буквы в диапазоне ячеек.

Я нашел в сети код, который работает:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Target, Range("A1:C10")) _
Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If

Он работает нормально, но я получаю ошибку несоответствия значений, когда копирую или вставляю несколько ячеек в указанный диапазон.Поэтому я попытался использовать этот код вместо этого:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Set r = Range("$A$1:$C$10")
    Application.EnableEvents = False
    For Each r In Target
        If Not r.HasFormula And r.Value <> "" Then
            r.Value = UCase(r.Value)
        End If
    Next
    Application.EnableEvents = True
End Sub

Этот код отлично работает даже при копировании и вставке, но он применяется ко всей электронной таблице, даже если для переменной r установлен диапазон.Зачем?Спасибо!

Answer 1

Вам просто нужно правильно объединить приемы двух примеров кода. Во втором коде отсутствует функция пересечения, в то время как в первом не хватает итерации для ряда вставленных ячеек. Попробуйте это:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Magic_Range As Range, Iterator_Range As Range
    Set Magic_Range = Range("$A$1:$C$10")
    Application.EnableEvents = False
    If Not Application.Intersect(Target, Magic_Range) Is Nothing Then
        For Each Iterator_Range In Application.Intersect(Target, Magic_Range)
            If Not Iterator_Range.HasFormula And Iterator_Range.Value <> "" Then
                Iterator_Range.Value = UCase(Iterator_Range.Value)
            End If
        Next Iterator_Range
    End If
    Application.EnableEvents = True
End Sub