Активировать макрос при изменении с переменной строкой в ​​диапазоне

Question

Я хочу активировать макрос при изменении диапазона.

Следующий код работает нормально, за исключением того, что я хочу переменную в последней строке (где B100 в настоящее время).

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B1:B100")) Is Nothing Then
        MsgBox "Updating sheets"
        Call Thickborders2

    End If
End Sub

Значение B100 в диапазоне зависит от последней строки с текстом в ней.

Answer 1

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

=MATCH("zzz", B:B)

Вышеприведенное возвращает последнюю строку в столбце B с текстовым значением.

Private Sub Worksheet_Change(ByVal Target As Range)

    dim m as variant
    m = application.match("zzz", columns("B"))
    if iserror(m) then m = 1

    If Not Intersect(Target, Range("B1").resize(m, 1)) Is Nothing Then

        MsgBox "Updating sheets"
        Call Thickborders2

    End If
End Sub

Я настоятельно рекомендую добавить контроль ошибок (on error goto <label>) и отключить триггеры событий (application.enableevents = false).Не забудьте повторно включить события перед выходом из подпрограммы.

Answer 2

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

Этот код вычисляет последнюю ячейку при перемещении ячеек (я пробовал событие Calculate, но это происходит после того, как вы добавили данные, так же как и в случае события Change).

Option Explicit

Private rLastCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set rLastCell = Cells(Rows.Count, 2).End(xlUp)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range(Cells(1, 2), rLastCell)) Is Nothing Then
        MsgBox "Updating sheets"
        Call Thickborders2
    End If
End Sub  

Первые две строки должны быть в самой верхней части модуля.

Answer 3

Опираясь на комментарии Таазара и L42, попробуйте:

Private Sub Worksheet_Change(ByVal Target As Range)
    LastCell = Activesheet.Usedrange.Rows.Count
    If Not Intersect(Target, Range("B1:B" & LastCell)) Is Nothing Then
        MsgBox "Updating sheets"
        Call Thickborders2
    End If
End Sub

Где Activesheet следует заменить на проверяемое имя листа.