Функция Worksheet_Change в VBA, использующая метод Intersect с ячейками в качестве определителя диапазона - PullRequest
Новая
       13

Функция Worksheet_Change в VBA, использующая метод Intersect с ячейками в качестве определителя диапазона

0 голосов
/ 19 сентября 2018

Я пытаюсь заставить свою электронную таблицу автоматически заполнять соответствующую ячейку, когда одна из связанных ячеек была изменена.Ранее я только что определил цель как: 

 If Target.Address = "$A$5" then

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

If Intersect(Target, Range(Cells(12,2), Cells(12,j-1))) Is Nothing Then

(я пытаюсь изменить ячейкиниже цели, причем целью является любая из ячеек между 12B и 12 (j-1) с j, ранее определенным) Я получаю следующую ошибку: «Ошибка времени выполнения« 1004 »: ошибка приложения или объекта«Но из того, что я могу сказать, мой код точно такой же, как и во всех примерах.

Мой полный код (хотя может быть и не связанная ошибка с моим vlookup также) 

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range(Cells(12, 2), Cells(12, j-1))) Is Nothing Then
    If IsEmpty(Target) Then
        Target.Interior.ColorIndex = 19
    Else:
        If Range("$A$13").Value = "" Then
            Range("$A$13").Value = "Care Type"
            Range("$A$13").Font.Bold = True
        End If
        Target.Interior.ColorIndex = xlNone
        Target.Offset(1, 0).Interior.ColorIndex = 19
        Target.Offset(2, 0).Value = Application.WorksheetFunction. _
            VLookup(Target, Sheets("Sheet2").Range("$E$3:$F$6"), 2)
        Target.Offset(2, 0).Font.Bold = True

        i = 2
        Do Until IsEmpty(Cells(11, i))
            If Cells(11, i).Value <= ChildCount Then
                Cells(12, i).Interior.ColorIndex = 19
            End If
        i = i + 1
        Loop
    End If
End If
End Sub

1 Ответ

0 голосов
/ 19 сентября 2018

После использования Intersect для определения того, что хотя бы одна ячейка в вашем диапазоне была изменена, вам нужно выполнить итерацию по соответствующим ячейкам.

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

Private Sub Worksheet_Change(ByVal Target As Range)

    If not Intersect(Target, Range(Cells(12, 2), Cells(12, 11))) Is Nothing Then
        on error goto safe_exit
        application.enableevents = false
        dim t as range
        for each t in Intersect(Target, Range(Cells(12, 2), Cells(12, 11)))
            If IsEmpty(t) Then
                t.Interior.ColorIndex = 19
            Else
                If Range("$A$13").Value = "" Then
                    Range("$A$13").Value = "Care Type"
                    Range("$A$13").Font.Bold = True
                End If
                t.Interior.ColorIndex = xlNone
                t.Offset(1, 0).Interior.ColorIndex = 19
                t.Offset(2, 0).Value = Application.WorksheetFunction. _
                    VLookup(Target, Sheets("Sheet2").Range("$E$3:$F$6"), 2)
                t.Offset(2, 0).Font.Bold = True

                i = 2
                'I really don't know what the following code is intended to do
                'probably better as a conditional formatting rule
                Do Until IsEmpty(Cells(11, i))
                    If Cells(11, i).Value <= ChildCount Then
                        Cells(12, i).Interior.ColorIndex = 19
                    End If
                i = i + 1
                Loop
            End If
        next t
    End If

safe_exit:
    application.enableevents = true

End Sub
...