Question

在我的工作表中，我有四个不同的类别。对于每个类别，都有 3〜5个不同的价格。还有其他属性。结果，每个类别被重复很多次，总共有30,000行。工作表的第一行具有所有列名。每个类别跨越连续的行。因此，我编写了以下函数来识别“块”并计算“块”的最小值。

Example Image of How Cat Blocks Look Like

    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

当我为单个单元格调用公式时，速度非常快。但是，我必须为30,000个单元格调用UDF，每次刷新一次计算最多需要五分钟。我想知道运行时是否有一些改进的余地。或者，如果有更好的方法可以使用内置公式解决它。

非常感谢。

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

识别VBA UDF Bottlneck

1 个答案: