FindNext не обновляет Range.Address при использовании цикла «Do Loop while»

Question

Я пытаюсь найти «DESC» в диапазоне ячеек, от A1 до последнего использованного столбца в «Сводке» на моей рабочей книге.Как только код найдет искомое значение, он проверит, является ли он DESC или TERMDESC.

'Gets Column Letter from Column Index
Dim vArr
Dim ColLetter As String
vArr = Split(Cells(1, Lastcolumn).Address(True, False), "$")
ColLetter = vArr(0) ' -->Column NA

'Loop begins
Dim cell As Range
Dim firstCellAddress as string
Dim DescMaxNumber As Integer
Dim TermDescMaxNumber As Integer
Dim ModString as string
Dim ModNumber as integer
DescMaxNumber = 0
TermDescMaxNumber = 0

Set cell = ThisWorkbook.Worksheets("Summary").Range("A1:" & ColLetter & "1").Find("DESC", LookIn:=xlValues)

If cell Is Nothing Then
    MsgBox "Not Found"
    Exit Sub
End If

Затем код проверит и проверит, есть ли у него целое число из последних двух букв (например, DESCA01строка 01 является целым числом) и, если она хранится в DescMaxNumber или TermDescMaxNumber.

 firstCellAddress = cell.Address

'Find all cells containing DESC including TERMDESC and max numeric value
Do
    SearchString = cell.Value

    'Determines if SearchString is DESC or TermDESC *BEGINNING*
    If InStr(1, SearchString, "DESC") = 1 Then
        ModString = Right(SearchString, 2)

        If IsNumeric(ModString) = True Then
            ModNumber = CInt(ModString)

            If DescMaxNumber < ModNumber Then
                DescMaxNumber = ModNumber
            End If
        End If

    ElseIf InStr(1, SearchString, "TERMDESC") = 1 Then
        ModString = Right(SearchString, 2)

        If IsNumeric(ModString) = True Then
            ModNumber = CInt(ModString)

            If TermDescMaxNumber < ModNumber Then
                TermDescMaxNumber = ModNumber
            End If
        End If
    End If
    Set cell = Range("A1:" & ColLetter & "1").FindNext(cell)
Loop While firstCellAddress <> cell.Address

MsgBox "DESC Max Number = " & DescMaxNumber
MsgBox "TERMDESC Max Number = " & TermDescMaxNumber

После этого он должен перейти к следующей ячейке со значением DESC.Вот в чем заключается моя проблема: при первом запуске кода он циклически перебирает все ячейки, содержащие DESC (D1, E1, F1 и т. Д.), И сообщает, что DescMaxNumber равен 34, а TermDescMaxNumber равен 36.

Если я снова запускаю код DexcMaxNumber = 0 и TermDescMaxNumber = 0, войдя в код, я заметил, что cell.address не меняется с D1 на E1, он просто остается на D1

Спасибо

Answer 1

При первоначальном вызове Find указывается, что диапазон, который мы ищем, находится на листе, называемом Summary в книге, где хранится этот код:

Set cell = ThisWorkbook.Worksheets("Summary").Range("A1:" & ColLetter & "1").Find("DESC", LookIn:=xlValues)

В вызовена FindNext, лист не указан, поэтому диапазон, который мы хотим найти, находится на активном листе (который может или не может быть рабочим листом, называемым «Сводка») в активной книге (которая может быть или не быть рабочей книгой, гдекод сохраняется):

Set cell = Range("A1:" & ColLetter & "1").FindNext(cell)

Чтобы это исправить, вы можете просто указать рабочий лист в вызове FindNext:

Set cell = ThisWorkbook.Worksheets("Summary").Range("A1:" & ColLetter & "1").FindNext(cell)

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

Dim rngToSearch As Range

Set rngToSearch = ThisWorkbook.Worksheets("Summary").Range("A1:" & ColLetter & "1")
Set cell = rngToSearch.Find("DESC", LookIn:=xlValues)

' do stuff with cell

Set cell = rngToSearch.FindNext(cell)

Answer 2

Хотя это и не прямой ответ на ваш вопрос как таковой, в этом случае вам, вероятно, было бы лучше использовать универсальную функцию FindAll, а затем обрабатывать отдельные ячейки в пределах найденного диапазона, чтобы получить ваши значения.

Я использовал несколько ярлыков, чтобы проиллюстрировать процесс, но вы должны иметь возможность адаптировать вызов FindAll к вашим потребностям.

Sub ProcessDesc()
    Dim wsSrc As Worksheet: Set wsSrc = ThisWorkbook.Sheets("Sheet1")

    Dim FoundRange As Range, Cell As Range, Val As Integer

    Dim DescMaxNumber As Integer: DescMaxNumber = 0
    Dim TermDescMaxNumber As Integer: TermDescMaxNumber = 0

    Set FoundRange = FindAll("*DESC*", wsSrc.UsedRange)

    For Each Cell In FoundRange
        Val = IIf(IsNumeric(Right(Cell, 2)), CInt(Right(Cell, 2)), 0)
        If InStr(Cell, "TERMDESC") Then
            TermDescMaxNumber = IIf(Val > TermDescMaxNumber, Val, TermDescMaxNumber)
        Else
            DescMaxNumber = IIf(Val > DescMaxNumber, Val, DescMaxNumber)
        End If
    Next Cell
    Debug.Print DescMaxNumber, TermDescMaxNumber

End Sub

Private Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = CurrRange
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, CurrRange)
            Else: Exit Do
            End If
        Loop
    End If
End Function