Найти следующий метод медленно только в последнем экземпляре

все.

Я запускаю этот код:

    Sub ISN_Flyer_Performance()
Dim FlyerSh As Worksheet
Dim QlikSh As Worksheet
Dim SKURng As Range
Dim QlikSKURng As Range
Dim SKU As Range
Dim qlr As Long
Dim QlikSKU As Range
Dim TotalSales As Double
Dim FirstQlikSku As Range

Set FlyerSh = ActiveSheet
i = 2
lr = FlyerSh.Range("A" & Rows.Count).End(xlUp).Row
Set QlikSh = Application.InputBox("Click any cell on the Qlikview Sheet you want to lookup against", "Find Qlikview Sheet", Type:=8).Worksheet

qlr = QlikSh.Range("A" & Rows.Count).End(xlUp).Row
Set QlikSKURng = Range(Cells(2, QlikSh.Rows(1).Find(What:="Item Number", LookAt:=xlWhole).Column), Cells(qlr, QlikSh.Rows(1).Find(What:="Item Number", LookAt:=xlWhole).Column))


Set SKURng = Range(FlyerSh.Cells(i, 1), FlyerSh.Cells(lr, 1))
Set SKU = FlyerSh.Cells(i, 1)
For Each SKU In SKURng
Set QlikSKU = QlikSKURng.Find(What:=SKU.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If QlikSKU Is Nothing Then
    SKU.Offset(0, 2).Value = 0
    GoTo NextSku
        Else
    TotalSales = QlikSKU.Offset(0, 5).Value
    Set FirstQlikSku = QlikSKU
        Do
        Set QlikSKU = QlikSKURng.FindNext(QlikSKU)
        If QlikSKU.Address = FirstQlikSku.Address Then Exit Do
        TotalSales = TotalSales + QlikSKU.Offset(0, 5).Value
        Loop
    SKU.Offset(0, 2) = TotalSales
        End If
NextSku:
Next SKU


End Sub

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

Итак, я использую этот цикл findnext для перебора диапазона (QlikSKURange), который содержит около 16 тыс. строк. findNext выполняется достаточно быстро, менее чем за секунду, ЗА ИСКЛЮЧЕНИЕМ последнего экземпляра, когда он возвращается к началу и снова находит первый экземпляр. Этот экземпляр может занять более десяти секунд.

Любая идея, почему это может быть?

Дайте мне знать, если вам нужна дополнительная информация о коде.

Я попытался просто «Найти» после текущей итерации, а не найти следующую, и у нее такое же замедление.

Рассматривали ли вы возможность не использовать FindNext? т. е. рассмотрите подпрограмму BolcCat() на этой странице ozgrid.com/VBA/VBALoops.htm

SpectralInstance 22.04.2022 22:35

Похоже, он использует Find вместо FindNext. Я тоже пробовал, такое же замедление. Только когда он больше не находит совпадений и снова возвращается к первому, он становится медленным. Все остальные находки происходят довольно быстро.

Gary Nolan 22.04.2022 22:42

Не могли бы вы добавить остальную часть кода? Мы не можем видеть, как вы ссылаетесь на диапазон, это один столбец, вычислили ли вы последнюю занятую строку и т. д.

VBasic2008 22.04.2022 22:48

Я только что обновил, чтобы добавить весь код. Проблема находится ближе к концу, в цикле Do While. FindNExt работает достаточно быстро, пока снова не найдет первый. Другие экземпляры FindNext выполняются менее чем за секунду, но когда он возвращается и снова находит первый, обычно это занимает более десяти секунд.

Gary Nolan 22.04.2022 22:50
3 метода стилизации элементов HTML
3 метода стилизации элементов HTML
Когда дело доходит до применения какого-либо стиля к нашему HTML, существует три подхода: встроенный, внутренний и внешний. Предпочтительным обычно...
Формы c голосовым вводом в React с помощью Speechly
Формы c голосовым вводом в React с помощью Speechly
Пытались ли вы когда-нибудь заполнить веб-форму в области электронной коммерции, которая требует много кликов и выбора? Вас попросят заполнить дату,...
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Будучи разработчиком веб-приложений, легко впасть в заблуждение, считая, что приложение без JavaScript не имеет права на жизнь. Нам становится удобно...
Flatpickr: простой модуль календаря для вашего приложения на React
Flatpickr: простой модуль календаря для вашего приложения на React
Если вы ищете пакет для быстрой интеграции календаря с выбором даты в ваше приложения, то библиотека Flatpickr отлично справится с этой задачей....
В чем разница между Promise и Observable?
В чем разница между Promise и Observable?
Разберитесь в этом вопросе, и вы значительно повысите уровень своей компетенции.
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Клиент для URL-адресов, cURL, позволяет взаимодействовать с множеством различных серверов по множеству различных протоколов с синтаксисом URL.
1
4
39
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Ответ принят как подходящий

Поиск VBA с использованием метода поиска

  • Это только основная идея. Есть много недостатков, например. если вы отмените поле ввода, если вы выберете «неправильный» рабочий лист (например, заголовок столбца не найден), если есть значения ошибок, пустые ячейки и т. д.
Option Explicit

Sub ISN_Flyer_Performance()
    
    ' Flyer
    Dim fws As Worksheet: Set fws = ActiveSheet ' improve!
    Dim fLR As Long: fLR = fws.Range("A" & fws.Rows.Count).End(xlUp).Row
    Dim frg As Range
    Set frg = fws.Range(fws.Cells(2, "A"), fws.Cells(fLR, "A"))
    'Debug.Print fws.Name, fLR, frg.Address
    
    ' Qlikview
    Dim qws As Worksheet: Set qws = Application.InputBox( _
        "Click any cell on the Qlikview Sheet you want to lookup against", _
        "Find Qlikview Sheet", Type:=8).Worksheet
    Dim qLR As Long: qLR = qws.Range("A" & qws.Rows.Count).End(xlUp).Row
    Dim qC As Long
    With qws.Rows(1) ' assuming that "Item Number" is surely in the first row
        qC = .Find("Item Number", .Cells(.Cells.Count), _
            xlFormulas, xlWhole).Column
    End With
    Dim qrg As Range
    Set qrg = qws.Range(qws.Cells(2, qC), qws.Cells(qLR, qC))
    'Debug.Print qws.Name, qLR, qC, frg.Address

    Application.ScreenUpdating = False
    
    Dim fCell As Range
    Dim qCell As Range
    Dim qFirstAddress As String
    Dim TotalSales As Double
    
    ' Loop.
    For Each fCell In frg.Cells
        Set qCell = qrg.Find(fCell.Value, qrg.Cells(qrg.Cells.Count), _
            xlFormulas, xlWhole)
        If qCell Is Nothing Then
            fCell.Offset(0, 2).Value = 0
        Else
            qFirstAddress = qCell.Address
            Do
                TotalSales = TotalSales + qCell.Offset(0, 5).Value
                Set qCell = qrg.FindNext(qCell)
            Loop Until qCell.Address = qFirstAddress
            fCell.Offset(0, 2).Value = TotalSales
            TotalSales = 0
        End If
    Next fCell

    Application.ScreenUpdating = True

    MsgBox "Lookup done.", vbInformation

End Sub

После дальнейших раскопок кто-то предположил, что проблема в том, что один из моих листов был столом. У него были фильтры в строке заголовка. Я удалил их (и условное форматирование в строке, чтобы найти дубликаты, и мой код запустился за считанные секунды. После изоляции этих двух оказалось, что виновником было условное форматирование.

Другие вопросы по теме