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

我已经使用了下面提到的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。

这可以优化吗？ 或者这可以等同于一个更快的macros？

它需要1秒更新1单元格！ 这是一个很长的时间来更新所有400K +单元格！

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

我把我的节目制作成了Martin Carlsson的节目。 它在30秒内处理100条logging。 可以改善吗？

 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

这应该工作，并且要比任何需要循环每行的VBA解决scheme快得多，只要您可以按列B降序对date进行sorting：

input以下公式作为数组（而不是input使用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) 

正在构build一个等于列B中行的值的数组，其中“testing”字在同一“行”列A中

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

这是使用由Id语句构build的数组来查找大于或等于来自testing数据的查找值的最小值。

 =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 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 

Answer 3

如果您的数据在列1中的列2上sorting，那么SpeedTools Filter.Ifs函数将比您的公式快得多（至less快50倍）

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

免责声明：我是SpeedTools的作者，这是一个商业Excel插件产品。
您可以从以下url下载完整的试用版本：
http://www.decisionmodels.com/FastExcelV3SpeedTools.htm

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