Выход из бесконечного цикла "Найти"

ProgramBox

Выход из бесконечного цикла «Найти»

Post author:admin
Запись опубликована:9 мая, 2023
Post category:Вопросы по программированию

#excel #vba

Вопрос:

Я создал цикл выполнения с помощью Find, чтобы заменить «Привет» на «Hi» внутри столбца A листа 1, но только если строка «XYZ» не находится в той же строке столбца B.

Когда Find не заменяет «Hello», потому что в столбце B есть «XYZ», мы вводим бесконечный цикл, поскольку FindNext всегда находит «Hello» в столбце 1

Можно избежать бесконечного цикла, не делая цикл очень сложным?

Пожалуйста, посмотрите на это изображение столбцов на листе 1

 Sub CallMask()
    Call Masks("Hello", "XYZ")
End Sub

Sub Masks(sMask_I As String, sNoReplace_I As String)
    With Sheets("Sheet1").Columns(1)
        Dim CellToReplace As Range
        Set CellToReplace = .Find(What:=sMask_I, LookIn:=xlValues, _
            SearchDirection:=xlNext, MatchCase:=True, Lookat:=xlPart)
        If Not CellToReplace Is Nothing Then
            Dim InitialAddress As String
            InitialAddress = CellToReplace.Address
            Dim MaskRow As Long
            Dim Mask As String
            On Error Resume Next
            Do
                MaskRow = WorksheetFunction.Match(sMask_I, _
                  Sheets("Sheet1").Range("C1:C" amp; Rows.Count), 0)
                Mask = Sheets("Sheet1").Range("D" amp; MaskRow).Value2
                If Sheets("Sheet1").Cells(CellToReplace.Row, 2) <> sNoReplace_I Then
                    CellToReplace.Value2 = Replace(CellToReplace.Value2, sMask_I, Mask)
                End If
                Set CellToReplace = .FindNext(CellToReplace)
            Loop While Not CellToReplace Is Nothing And CellToReplace.Address _
              <> InitialAddress
            On Error GoTo 0
        End If
    End With
End Sub

1. Вы могли бы проверить с помощью COUNTIF() , находится ли «XYZ» в той же строке, и работать оттуда?

2. Загруженный мной код является упрощением реального. Было бы невозможно использовать COUNTIF () в моем реальном коде. Спасибо, Брюс

Ответ №1:

Вы могли бы попробовать это:

 Option Explicit

Sub CallMask()
    Call Masks("Hello", "XYZ", "Hi")
End Sub

Sub Masks(sMask_I As String, sNoReplace_I As String, Replacement As String)
    Dim C As Range
    With ThisWorkbook.Sheets("Sheet1")
        For Each C In .Range("A1", "A" amp; .Cells(.Rows.Count, 1).End(xlUp).Row)
            If C Like "*" amp; sMask_I amp; "*" And C.Offset(0, 1) <> sNoReplace_I Then
                C.Replace sMask_I, Replacement
            End If
        Next C
    End With

End Sub

1. Спасибо, Дамиан, ваш код работает очень хорошо, но использует цикл For Next и работает очень медленно. Вот почему я хочу использовать метод Find

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

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

4. @Malamare For Each было бы самым быстрым способом перебора ячеек в a Range , поскольку a Range по сути является коллекцией Range объектов, а коллекции объектов лучше всего перебирать с For Each помощью. For...Next Цикл намного быстрее для итерации массивов — в любом случае, любой код, который взаимодействует с ячейками в цикле, будет намного медленнее, чем это должно быть. Рассмотрите возможность копирования значений ячеек в массив и использования For цикла для итерации массива вместо этого; измените массив на месте, затем замените все ячейки содержимым массива за одну операцию записи на рабочий лист. Так будет быстрее.

Ответ №2:

При использовании Find() в цикле обычно проще абстрагировать это в отдельный метод:

 Sub CallMask()
    Masks "Hello", "XYZ"
End Sub

Sub Masks(sMask_I As String, sNoReplace_I As String)
    Dim matches As Collection, c

    Set matches = FindAll(Sheets("Sheet1").Columns(1), sMask_I)

    For Each c In matches
        If c.Offset(0, 1) <> sNoReplace_I Then
            c.Value = Replace(c.Value, sMask_I, c.Offset(0, 3).Value)
        End If
    Next c

End Sub

'return all matches as a collection
Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function

1. Спасибо, Тим! ваш код хорошо работает для меня. Измените только «c.Смещение (0, 3) .значение» ссылкой на «Hi». если смещение не возвращено, «» за исключением первой строки

Ответ №3:

Я тестировал с массивами, как было предложено Дамианом, AJD и Матье. Это самый быстрый код.

Время для 1600 строк равно:

Мой новый код с массивами: 8 мс
Дамиан кодирует с для следующего: 132 мс
Код с «отдельным методом» Тима Уильямса: 402 мс
Мой первый код с Find: 511 мс

Это новый код:

 Sub CallMask()
    Call Masks("Hello", "XYZ")
End Sub

Sub Masks(ByVal sMask_I As String, ByVal sNoReplace_I As String)

    With ThisWorkbook.Sheets("Sheet1")
        Dim ArrayRangeToMask As Variant
        ArrayRangeToMask = .Range("A1:B" amp; .Cells(.Rows.Count, 2).End(xlUp).Row)

        Dim MaskRow As Long
        Dim Mask As String
        MaskRow = WorksheetFunction.Match(sMask_I, .Range("C1:C" amp; Rows.Count), 0)
        Mask = .Range("D" amp; MaskRow).Value2

        Dim RowMasking As Long
        For RowMasking = 1 To UBound(ArrayRangeToMask)
            If InStr(ArrayRangeToMask(RowMasking, 1), sMask_I) And _
              ArrayRangeToMask(RowMasking, 2) <> sNoReplace_I Then
                ArrayRangeToMask(RowMasking, 1) = _
                  Replace(ArrayRangeToMask(RowMasking, 1), sMask_I, Mask)
            End If
        Next RowMasking

        .Range("A1:B" amp; .Cells(.Rows.Count, 2).End(xlUp).Row) = ArrayRangeToMask
    End With

End Sub