Question

我使用了下面提到的excel公式。

=INDEX(TABL,SMALL(IF(COUNTIF(H2,$A$1:$A$325779)*COUNTIF(I2,"<="&$B$1:$B$325779),ROW(TABL)-MIN(ROW(TABL))+1),1),3)

其中“TABL”表是A1：E325779，是我查找数组的来源。

提到的公式是确切的要求，但是需要花费大量时间来更新包含此公式的400,000多个细胞的excel。

这可以优化吗？或者这可以等同于更快的宏？

花1秒钟更新1个单元！这是一次很长时间来更新所有400K +细胞!!!

示例工作表的屏幕截图如下所示。

enter image description here

我的计划是基于Martin Carlsson的。它在30秒内处理100条记录。可以改进吗？

Sub subFindValue()
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Cells(2, 12) = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")

    Dim varRow As Variant
    Dim varRowMain As Variant
    Dim lookupTable As Variant
    Dim lookupValueTable As Variant

    lookupValueTable = Range("G2:J309011").Value
    lookupTable = Range("A2:D325779").Value

    varRowMain = 1
    varRow = 1

    Do Until varRowMain = 309011
        Do Until varRow = 325779
            If lookupTable(varRow, 1) = lookupValueTable(varRowMain, 1) And lookupTable(varRow, 2) >= lookupValueTable(varRowMain, 2) Then
                lookupValueTable(varRowMain, 3) = lookupTable(varRow, 3)
                lookupValueTable(varRowMain, 4) = lookupTable(varRow, 4)
                Exit Do
            End If
            varRow = varRow + 1
        Loop

        If IsEmpty(lookupValueTable(varRowMain, 3)) Then
            lookupValueTable(varRowMain, 3) = "NA_OX"
            lookupValueTable(varRowMain, 4) = "NA_OY"
        End If

        varRowMain = varRowMain + 1
        varRow = 1
    Loop
    Range("G2:J309011").Value = lookupValueTable

    Cells(3, 12) = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Answer 1

这是你需要的吗？

Sub subFindValue()
    'Speed up
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim strNamedValue As String: strNamedValue = Range("E3")
    Dim curHigherThanValue As Currency: curHigherThanValue = Range("F3")
    Dim varRow As Variant

    varRow = 1
    Do Until IsEmpty(Cells(varRow, 1))
        If Cells(varRow, 1) = strNamedValue And Cells(varRow, 2) > curHigherThanValue Then
            Range("G3") = Cells(varRow, 3)
            Exit Do
        End If
        varRow = varRow + 1
        Loop

    'Slow down
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    End Sub

Answer 2

如果您的数据在第1列的第2列中排序，那么SpeedTools Filter.Ifs功能将比您的公式快得多（至少快50倍）

=FILTER.IFS(2,$A$1:$C$325779,3,1,E3,2,">" & F3)

免责声明：我是SpeedTools的作者，这是一款商业Excel插件产品。
您可以从：http://www.decisionmodels.com/FastExcelV3SpeedTools.htm

下载完整的试用版

Answer 3

只要您可以对B列Descending中的日期进行排序，这应该比任何需要循环每一行的VBA解决方案都要快，并且要快得多：

输入以下公式作为数组（而不是按Enter键使用Ctrl + Shift + Enter

=INDEX($C$1:$C$15,MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1))

你应该得到类似的东西：

enter image description here

说明：

IF($A$1:$A$15=F2,$B$1:$B$15)

构建一个值数组，其值等于B列中的行，其中Test字在同一行A列中。

MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1)

这是使用从Id语句构建的Array来查找大于或等于测试数据的查找值的最小值。

=INDEX($C$1:$C$15,MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1))

一旦完成，“INDEX”将返回C列中与匹配值位于同一位置的值。

更新： 如果您正在寻找tigeravatar的回答，那么这是另一个将返回所有值的VBA函数：

Sub GetValues()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Dim strMetalName As String: strMetalName = [E3]
Dim dbMinimumValue As Double: dbMinimumValue = [F3]

Range("G3:G" & Rows.Count).ClearContents

With Range("TABL")
    .AutoFilter Field:=1, Criteria1:=strMetalName
    .AutoFilter Field:=2, Criteria1:=">=" & dbMinimumValue, Operator:=xlAnd
     Range("C2", [C2].End(xlDown)).Copy [G3]
    .AutoFilter
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

对我来说，他需要花费5-7分钟才能运行，这需要1.5秒，其中我的第一个回答返回包含最接近匹配结果的单行，此子将返回大于或等于的所有值。

Answer 4

您可能需要调整输出的位置（假设结果应该在单元格G3中向下输出），但这应该很快运行：

Sub subFindValue()

    Dim rngFound As Range
    Dim arrResults() As Variant
    Dim varFind As Variant
    Dim dCompare As Double
    Dim ResultIndex As Long
    Dim strFirst As String

    varFind = Range("E3").Text
    dCompare = Range("F3").Value2

    Range("G3:G" & Rows.Count).ClearContents

    With Range("TABL").Resize(, 1)
        Set rngFound = .Find(varFind, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            ReDim arrResults(1 To WorksheetFunction.CountIf(.Cells, varFind), 1 To 1)
            strFirst = rngFound.Address
            Do
                If rngFound.Offset(, 1).Value > dCompare Then
                    ResultIndex = ResultIndex + 1
                    arrResults(ResultIndex, 1) = rngFound.Offset(, 2).Text
                End If
                Set rngFound = .Find(varFind, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    End With

    If ResultIndex > 0 Then Range("G3").Resize(ResultIndex).Value = arrResults

End Sub

优化使用大型数组的Excel公式

4 个答案: