从过滤的数据的最小值的行中删除filter/复制数据时，优化代码以更快获得乐趣

我有第1页（115行）第1和第2列的数据。 这些是我的参考价值。 我在ActiveSheet（10000+）列3和4中有数据。 这些是我的原始数据值。

我有下面的代码将find最接近的原始数据值的参考值通过取得差异，find0和15分钟之间的值，find最小值，并从该行复制到另一个位置的其他数据。

我在过程中使用了2个自动filter来为每个参考值做这个，所以它发生了115次。 我的问题如下：

1. 是添加/删除filter减慢我的search？ 我应该只查看所有10,000个数据值，而不是先在同一天过滤？
2. 当我find过滤列表的最小值的值时，是否有更好的方法来快速复制同一行的其他列的数据？

我在这段代码的最后添加了一个计时器来帮助量化。 我希望你能帮助！

Sub UpdatedTimeMatcherwithFilters() 'Make the code as fast as possible Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim MinValue, MinRow As Integer Dim searchRange, Rng As Range Dim elapsedTime As Integer startTime = Time Set searchRange = Range("G1:G1697") 'Count the reference values TotalRefVal = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row 'Count the Raw Data Values Set Rng = Range("C2:C1000") 'TotalRawDataVal = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row 'Format the Columns as needed Columns("G:G").Select Selection.NumberFormat = "[h]:mm:ss;@" Columns("I:I").Select Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@" Columns("H:H").Select Selection.NumberFormat = "m/d/yy;@" For j = 2 To TotalRefVal 'Filter for date of reference value ActiveSheet.Range("$C:$C").AutoFilter Field:=1, Operator:=xlFilterValues, _ Criteria2:=Array(2, "10/10/2014") 'Find the difference in times between Reference Data and Raw Data, 'put the difference value in the same row For Each d In Rng.SpecialCells(xlCellTypeVisible) ActiveSheet.Cells(d.Row, 7) = Worksheets("Sheet1").Cells(j, 5) - d Next d 'Turn off filter in column C ActiveSheet.AutoFilterMode = False 'Filter the Time Differences between 0 and 15 minutes ActiveSheet.Range("$G:$G").AutoFilter Field:=1, Criteria1:=">0:00:00", _ Operator:=xlAnd, Criteria2:="<0:15:00" 'Find the Minimum value between 0 and 15 minutes MinValue = Application.Min(searchRange.SpecialCells(xlCellTypeVisible)) 'Find the Row of the value of the minimum difference MinRow = Application.Match(MinValue, searchRange, 0) 'Copy the Data from columns C and D of minimum value's row Cells(j, 9).Value = Cells(MinRow, 3) Cells(j, 10).Value = Cells(MinRow, 4) ActiveSheet.AutoFilterMode = False Next j stopTime = Time elapsedTime = (stopTime - startTime) * 24 * 60 * 60 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "Elapsed time, screen updating on: " & elapsedTime & _ " sec." Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub 

Answer 1

你为什么不先订购你的原始数据（他们是date/时间？）？ 因为那样你就可以将原始数据划分成不同的部门，给定的参考价值只会在这个部门中看到。 不需要很长时间就可以按列sorting一组数据（甚至可以在另一列上进行二次sorting）。

好处是你只需要做一次，无论你在那些有序的数据上使用多less引用…

编辑作出更明确的答案（评论后）

不，我不认为你需要重新整理你的数据。 看这个excel文件：

我正在研究条形码，但是您可以按date或其他任何值进行sorting。 “随机”列在那里，以便我可以在testing我的代码后以随机顺序replace我的数据。

比方说，我通过条形码（在这张表中有200行，但是你可以根据你有多less行）的基础上，用这样的东西sorting。 首先，您需要调用一个对所有原始数据进行sorting的函数。 你可以做主要sorting（我首先按列Asorting），然后在相等的情况下，我有第二个sorting值。 你可以有更多的，只是searchSORT方法：

 Private Sub sorting_all() Dim test As Range Set test = Range("J" & 200) Sheet1.Range("A1", Sheet1.Cells(200, 10)).Sort key1:=Sheet1.Range("A1"), order1:=xlAscending, key2:=Sheet1.Range(Columns(8).Address()), order2:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns End Sub 

那么你会有一个函数，find一个给定的值：

 Function findValue(myValue As Long) As Range Dim numIntervales As Integer, startAt As Long, i As Integer, myIntervales As Variant, cutoff As Long 'as Long not Integer so you don't overflow numIntervales = 4 'or whatever, set this according to your data. Could determine this programatically myIntervales = getIntervales(numIntervales) For i = 1 To numIntervales - 1 'Because if you want 4 intervales, that means 3 cutoff points cutoff = Sheet1.Cells(myIntervales(i), 1).Value If myValue <= cutoff Then startAt = myIntervales(i - 1) 'If myValue < cutoff #1, then you want to start at myIntervales point between 0-1 Exit For ElseIf i = numIntervales Then startAt = myIntervales(numIntervales - 1) End If Next i Set findValue = Sheet1.Cells.Find(What:=myValue, After:=Sheet1.Cells((startAt + 1), 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False) End Function 

这个函数依赖于查找数据的范围，所以这个函数：

 Function findRange(mySheet As Worksheet, byRow_Or_byCol As String) As Range 'Just to find the extend of your data If byRow_Or_byCol = "byRow" Then Set findRange = mySheet.Cells.Find(What:="*", After:=mySheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False) Else Set findRange = mySheet.Cells.Find(What:="*", After:=mySheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False) End If End Function 

而且把你的原始数据分成合适的intervales，所以像这样：

 Function getIntervales(numIntervales) As Variant Dim myIntervales() As Integer, i As Integer, myRange As Range, myStep As Long Set myRange = findRange(Sheet1, "byRow") myStep = Round(myRange.Row / (numIntervales)) 'In my case, 200 rows & 4 intervales = 50 rows per intervale For i = 0 To (numIntervales - 1) 'Because array index start @ 1 ReDim Preserve myIntervales(i) ' myIntervales(i) = myStep * (i) + 1 'Because row(0) doesn't exist Next i getIntervales = myIntervales End Function 

最后，你需要一些主要的sorting协调所有这一切：

 Private Sub main() Call sorting_all MsgBox ("This is you result " & findValue(Sheet2.Cells(1, 1).Value).Row) End Sub 

这部分是基于某个项目的一些随机testing代码，所以它不是很完整，但你会明白（例如，sorting方法的范围是硬编码的，显然你想以编程方式find它） 。

你可能会更喜欢这个，例如，当你导入你的数据时，你只需要在（已经sorting的）数据的末尾添加数据，然后只在新添加的数据上调用sortingfunction（所以你不需要sorting10000行，如果你只增加了900个未sorting的行）。

你也可以通过编程的方式来确定你所设置的intervales，例如说你想要1000或2000行的intervales（只是决定什么对于速度/效率最好）。

最后，如果你要添加大量的数据，你可以像你提到的那样devise一个系统，这样一旦你的工作expression到10 000行（例如），它就会启动一个新的工作表并且closures那个工作表。再次，如果数据是sorting的，你可以编码，所以你知道Sheet1的数据从DATE XXXX到DATE YYYY等等