Определить VBA UDF Боттлнек

Question

В моей рабочей таблице у меня есть четыре разных категории. Для каждой категории есть 3 ~ 5 разных цен. Есть и другие атрибуты. В результате каждая категория дублируется много раз, и общее количество строк составляет 30 000. В первой строке листа есть все имена столбцов. Каждая категория охватывает последовательные ряды. Поэтому я написал следующую функцию для определения «блоков» и вычисления минимума «блоков».

Пример изображения того, как выглядят блоки Cat

    Public Function blockMin(rng_temp As Range) As Integer

        Dim currRow As Long
        currRow = rng_temp.Row

        'Find Category col
        Dim rng As Range
        Dim cabin_col As Long
        Dim price_col As Long


        For Each rng In Range("1:1")
            If rng.Value = "Cat" Then
                cat_col = rng.Column
            End If
            If rng.Value = "Price" Then
                pric_col = rng.Column
            End If
        Next rng

        Dim cat_col_char, price_col As String
        cat_col_char = Number2Letter(cat_col)
        price_col_char = Number2Letter(price_col)

        ' Find last row of the usedRange    
        Dim lastRow As Long
        lastRow = findLastRow()

        'Where the block is for each cat
        Dim startRow, endRow As Long
        startRow = rng_temp.Row
        endRow = rng_temp.Row

         'Find Top
        Do While startRow >= 2
            If Range(cat_col_char & startRow).Value <> Range(cat_col_char & currRow) Then
                startRow = startRow + 1
                Exit Do
            End If
            startRow = startRow - 1
        Loop

        If startRow = 1 Then startRow = 2   ' at the very top

         'Find Bottom
        Do While endRow <= lastRow - 1
            If Range(cat_col_char & endRow).Value <> Range(cat_col_char & currRow) Then
                endRow = endRow - 1
                Exit Do
            End If
            endRow = endRow + 1
        Loop

        If endRow = lastRow - 1 Then endRow = lastRow ' at the very bottom

        'Return min of the block
        Dim block As Range
        Set block = Range(price_col_char & startRow & ":" & price_col_char & endRow)

        blockMin = Application.WorksheetFunction.Min(block)

    End Function

Когда я вызываю формулу для одной ячейки, это довольно быстро. Однако мне нужно вызвать UDF для 30 000 ячеек, и это занимает до пяти минут на каждое обновление вычислений. Мне было интересно, есть ли место для улучшений во время выполнения. Или, если есть лучший способ обойти это с помощью встроенной формулы.

Спасибо большое.

Answer 1

Примерно так будет немного быстрее:

Public Function blockMin(rng_temp As Range) As Integer 'double?

    Dim sht As Worksheet, rS As Long, rE As Long, cat, v
    Dim hdrs, i As Long
    Dim cat_col As Long, price_col As Long

    Set sht = rng_temp.Worksheet '<<< scope all references to this sheet
                                 ' or you'll get odd results when a different
                                 ' sheet is active
    rS = rng_temp.Row
    rE = rS

    'Find headers
    hdrs = sht.Range("A1").Resize(1, 100).Value 'limit your search range
    For i = 1 To UBound(hdrs, 2)
        v = hdrs(1, i)

        If cat_col = 0 And v = "Cat" Then cat_col = i
        If price_col = 0 And v = "Price" Then price_col = i

        If cat_col > 0 And price_col > 0 Then
            cat = rng_temp.EntireRow.Cells(cat_col).Value
            If Len(cat) > 0 Then
                'find start/end rows
                Do While rS > 1 And sht.Cells(rS, cat_col) = cat
                    rS = rS - 1
                Loop
                Do While sht.Cells(rE, cat_col) = cat
                    rE = rE + 1
                Loop

                blockMin = Application.Min(sht.Range(sht.Cells(rS + 1, price_col), _
                                                     sht.Cells(rE - 1, price_col)))
            End If
            Exit For
        End If
    Next i

End Function