0

我使用了下面提到的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+ 单元格需要很长时间！！！

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

在此处输入图像描述

我的程序基于 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
4

4 回答 4

2

这是你需要的吗？

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
于 2013-09-04T11:40:00.390 回答
1

如果您的数据在第 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

于 2013-09-04T15:20:17.580 回答
1

您可能需要调整输出的去向（它假定结果应该在单元格 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
于 2013-09-04T16:01:54.477 回答
1

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

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

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

你应该最终得到类似的东西：

在此处输入图像描述

解释：

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

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

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

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

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

一旦全部组合在一起，'INDEX' 将返回 C 列中与匹配值位于相同位置的值。

更新：如果您正在寻找tigeravatar's Answer 返回的内容，那么这里是另一个将返回所有值的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 秒，我的第一个答案返回包含最接近匹配结果的单行，这个子也将返回大于或等于的所有值。

于 2013-09-04T15:53:01.403 回答