Матч не меняется, когда вы пересекаете рабочие листы. - PullRequest
0 голосов
/ 31 марта 2020

Используя приведенную ниже функцию сопоставления и циклические рабочие листы, вычисление неверно при сопоставлении рабочего листа после листа, в котором было найдено значение. Так, например, на 2-м листе lRow = 209 и на 3-м листе, где не должно быть совпадений, lRow по-прежнему 209, а не ошибка / ноль.

Sub lvl()

    Dim lRow As Long
    Dim ws As Worksheet
    Dim starting_ws As Worksheet

    Set starting_ws = ActiveSheet

        For Each ws In ThisWorkbook.Worksheets

         ws.Activate
         On Error Resume Next

         lRow = Application.WorksheetFunction.Match("LVL", ws.Range("A1:A1000"), 0)


            If lRow > 0 Then
                If Cells(lRow, 2).Value > 1 Then

                    Cells(lRow, 2).Select
                    Selection.End(xlDown).Select
                    TheActiveRow1 = ActiveCell.Row
                    TheActiveColumn1 = ActiveCell.Column

                    Selection.End(xlDown).Select
                    TheActiveRow2 = ActiveCell.Row
                    TheActiveColumn2 = ActiveCell.Column

                End If
            End If

        Next

    starting_ws.Activate

End Sub

Ответы [ 2 ]

1 голос
/ 31 марта 2020

Кроме того, что CLR уже указал, в вашем коде есть еще один существенный недостаток: вы не ссылаетесь на текущий ws внутри вашего l oop

, кроме того, всего этого Select и Activate не обязательно, если не Dangerous

, поэтому вы можете попробовать следующую версию вашего кода

Sub lvl()

    Dim lRow As Long, TheActiveRow1 As Long, TheActiveColumn1 As Long, TheActiveRow2 As Long, TheActiveColumn2 As Long
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        Dim found As Range
        If ws.Name <> ActiveSheet.Name Then 'avoid processing active sheet
            With ws ' reference current worksheet
                Set found = .Range("A1:A1000").Find(what:="LVL", LookIn:=xlValue, lookat:=xlWhole)
                If Not found Is Nothing Then

                    With .Cells(found.Row, 2) 'reference referenced sheet column B cell in same row as found one
                        If .Value > 1 Then                    
                            With .End(xlDown).Select 'reference referenced cell next cell reached by .End(xlDown)
                                TheActiveRow1 = .Row
                                TheActiveColumn1 = .Column

                                With .End(xlDown)  'reference referenced cell next cell reached by .End(xlDown)                               
                                    TheActiveRow2 = .Row
                                    TheActiveColumn2 = .Column
                                End With
                            End With
                        End If
                    End With
                End If
            End With
        End If
    Next


End Sub
1 голос
/ 31 марта 2020

Ваша проблема здесь:

On Error Resume Next
lRow = Application.WorksheetFunction.Match("LVL", ws.Range("A1:A1000"), 0)

lRow на самом деле не изменится, если "LVL" не найден, как если бы Match не удался, выполнение выдает ошибку в этой строке (которую вы резюме рядом с). Если вы хотите, чтобы lRow было нулем, когда ничего не найдено, установите его на ноль, прежде чем использовать функцию Match:

On Error Resume Next
lRow = 0
lRow = Application.WorksheetFunction.Match("LVL", ws.Range("A1:A1000"), 0)

В качестве альтернативы рассмотрите возможность использования Application.Match вместо этого и перехвата с помощью IsError:

'On Error Resume Next <-no need for this
lRow = Application.Match("LVL", ws.Range("A1:A1000"), 0)
If IsError(lRow) then lRow = 0
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...