Как задать ограничение и вывод поиска?

Question

[Владимир]

Добрый день подскажите пожалуйста как ограничить диапозон поиска допустим по A1:A10 и B1:B10
В коде менял дипозон в Range но всё равно выводит значение по всему листу

Option Explicit
Public sValue As String
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) 'задаем условие запуска программы - SheetChange запуск при внесении изменений
    If sh.Name = "LOG" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "Данные по организация" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Сводка" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "Инструкция" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Дашбоард" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Подрядчики" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Календарь" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "DASHBOARD" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Processing" Then Exit Sub 'исключаем лист из числа проверяемых
    Dim sLastValue As String  'назначаем переменные
    Dim lLastRow As Long      'назначаем переменные
 
    With Sheets("LOG")
        lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        If lLastRow = Rows.Count Then Exit Sub
        Application.ScreenUpdating = False: Application.EnableEvents = False
        .Cells(lLastRow, 1) = CreateObject("wscript.network").UserName 'записываем в первый столбец учетные данные иницатора изменений
        .Cells(lLastRow, 2) = Target.Address(0, 0)                     'записываем во второй столбец адрес изменяемой ячейки
        .Cells(lLastRow, 3) = Format(Now, "dd.mm.yyyy")       'записываем в третий столбец дату
        .Cells(lLastRow, 4) = Format(Now, "HH:MM:SS")         'записываем   время
        .Cells(lLastRow, 5) = sh.Name                                  'записываем  старое занчение ячейки
        .Cells(lLastRow, 6).NumberFormat = "@"                         ' ?????
        .Cells(lLastRow, 6) = sValue                                   'записываем новое значение ячейки
        If Target.Count > 1 Then
        If Intersect(Target, sh.Range("A:G")) Is Nothing Then Exit Sub ' ограничиваем диаппазон поиска измененных ячейки
            Dim rCell As Range, rRng As Range
            On Error Resume Next
            Set rRng = Intersect(Target, sh.UsedRange): On Error GoTo 0
            If Not rRng Is Nothing Then
                For Each rCell In rRng
                    If Not IsError(Target) Then sLastValue = sLastValue & "," & rCell Else sLastValue = sLastValue & "," & "Err"
                Next rCell
                sLastValue = Mid(sLastValue, 2)
            Else
                sLastValue = ""
            End If
        Else
            If Not IsError(Target) Then sLastValue = Target.Value Else sLastValue = "Err"
        End If
        .Cells(lLastRow, 7).NumberFormat = "@"
        .Cells(lLastRow, 7) = sLastValue
    End With
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
   If sh.Name = "LOG" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "Данные по организация" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Сводка" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "Инструкция" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Дашбоард" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Подрядчики" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Календарь" Then Exit Sub  'исключаем лист из числа проверяемых
    If sh.Name = "DASHBOARD" Then Exit Sub 'исключаем лист из числа проверяемых
    If sh.Name = "Processing" Then Exit Sub 'исключаем лист из числа проверяемых

    If Target.Count > 1 Then
        Dim rCell As Range, rRng As Range
        On Error Resume Next
        Set rRng = Intersect(Target, sh.UsedRange): On Error GoTo 0
        If rRng Is Nothing Then Exit Sub
        For Each rCell In rRng
            If Not IsError(rCell) Then sValue = sValue & "," & rCell Else sValue = sValue & "," & "Err"
        Next rCell
        sValue = Mid(sValue, 2)
    Else
        If Not IsError(Target) Then sValue = Target.Value Else sValue = "Err"
    End If
End Sub

Comments

[Владимир]

If Intersect(Target, sh.Range("A:G")) Is Nothing Then Exit Sub ' ограничиваем диаппазон поиска измененных ячейки

Менял sh.Range в это строчке, выводит значения по всему листу.

[Sergey В.]

Вы хоть аннотацию дайте - что это и для чего?
И в каком месте вонзикают затруднения?

[Elvis]

при поиске проверяйте в какой ячейке нашли. если не в нужном диапазоне - ищите дальше.

[Владимир]

BasiC2k, Нужно для создания журнала изменений. Затык заключается в том, что ищет и выводит на лист "LOG" изменения по всему листу, а необходимо только в заданном диапозоне.

Трудности возникают в отсутствие знаний по vba. Я пробовал изменить sh.Range на нужный мне диапозон, но ничего не получилось, так же ищет(выводит) изменения по всему листу

[Владимир]

BasiC2k, Вы мне помогли в этом вопросе https://qna.habr.com/q/1198262

Я нашёл макрос и возник ещё один вопрос)

[Sergey В.]

Владимир,
Делайте проверку на принадлежность к нужному диапазону, при перечислении изменённых ячеек:

For Each rCell In rRng
    If rCell.Row <= 10 And rCell.Column = 1 Then ' Ячейка находится в диапазоне A1:A10
         ' Обработка
   End If 
Next rCell

писал не проверяя, но я думаю принцип должен быть понятен.