在Excel VBA中筛选

我在VBA中有一个循环，循环了大约3000多条logging，并隐藏了不符合标准的logging。 它工作得很好，但它运行速度慢。 根据以下标准，是否有更快或更有效的过滤方式？ 任何帮助将不胜感激。

Dim i As Long, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, j As Long, sheetName As String, rng6 As Range, rng7 As Range, rng8 As Range, rng9 As Range Set rng1 = FindHeader("Client Exclusion List", Sheet8.Name) Set rng2 = FindHeader("CLIENT NAME", Sheet5.Name) Set rng3 = FindHeader("MARKET SEGMENT", Sheet5.Name) Set rng4 = FindHeader("ARCHIVED", Sheet5.Name) Set rng5 = FindHeader("FORMULARY NAME", Sheet5.Name) Set rng6 = FindHeader("WEBSITE", Sheet5.Name) Set rng7 = FindHeader("PDF", Sheet5.Name) Set rng8 = FindHeader("HPMS EXPORTED", Sheet5.Name) Set rng9 = FindHeader("SERFF EXPORTED", Sheet5.Name) For i = 1 To rng2.Rows.Count 'Checks to see if the Client Name is in the Excluded list For j = 1 To rng1.Rows.Count If rng2.Cells(i, 1).Value = rng1.Cells(j, 1).Value Then rng2.Cells(i, 1).EntireRow.Hidden = True End If Next j 'Checks For all CMS records and hides the ones that are not from current year If Left(rng3.Cells(i, 1).Value, 8) = "CMS Part" Then If rng3.Cells(i, 1).Value <> "CMS Part D (CY " & Year(Date) & ")" Then rng3.Cells(i, 1).EntireRow.Hidden = True End If End If 'Checks if record is archived If rng4.Cells(i, 1).Value = "Yes" Then rng4.Cells(i, 1).EntireRow.Hidden = True End If 'Checks if record contains "Test" or "Demo" in the Name If InStr(1, CStr(rng5.Cells(i, 1).Value), "test") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "Test") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "demo") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "Demo") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "TEST") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "DO NOT USE") > 0 Then rng5.Cells(i, 1).EntireRow.Hidden = True End If Next i 

Answer 1

这是一个应该更快的例子。 它使用数组，自动filter，并不处理rng2每一行的所有其他范围：

 Dim rng1 As Range Dim rng2 As Range Dim rng3 As Range Dim rng4 As Range Dim rng5 As Range Dim rng6 As Range Dim rng7 As Range Dim rng8 As Range Dim rng9 As Range Dim i As Long Dim j As Long Dim sheetName As String Dim vData1 Set rng1 = FindHeader("Client Exclusion List", Sheet8.Name) Set rng2 = FindHeader("CLIENT NAME", Sheet5.Name) Set rng3 = FindHeader("MARKET SEGMENT", Sheet5.Name) Set rng4 = FindHeader("ARCHIVED", Sheet5.Name) Set rng5 = FindHeader("FORMULARY NAME", Sheet5.Name) Set rng6 = FindHeader("WEBSITE", Sheet5.Name) Set rng7 = FindHeader("PDF", Sheet5.Name) Set rng8 = FindHeader("HPMS EXPORTED", Sheet5.Name) Set rng9 = FindHeader("SERFF EXPORTED", Sheet5.Name) Application.ScreenUpdating = False vData1 = rng1.Value For i = 1 To rng2.Rows.Count 'Checks to see if the Client Name is in the Excluded list For j = LBound(vdata1, 1) To UBound(vdata1, 1) If rng2.Cells(i, 1).Value = vdata1(j, 1) Then rng2.Cells(i, 1).EntireRow.Hidden = True Exit For End If Next j Next i 'Checks For all CMS records and hides the ones that are not from current year rng3.AutoFilter 1, "<>CMS Part*", xlOr, "CMS Part D (CY " & Year(Date) & ")" 'Checks if record is archived rng4.AutoFilter 1, "<>Yes" 'Checks if record contains "Test" or "Demo" in the Name rng5.AutoFilter 1, "<>*test*", xlAnd, "<>*demo*" Application.ScreenUpdating = True 

Answer 2

应该有所帮助的一个小改变是增加

 Application.ScreenUpdating = False 

在开始和

 Application.ScreenUpdating = True 

最后

屏幕更新时间可能比逻辑更为实质。

作为数组循环的替代编辑 。 在大循环之前创build一个填充了排除项目的字典作为键。 一套会更好，因为你有一个无用的项目去每个键，但我不认为VBA有这些。

而不是通过范围或数组循环，你只需检查字典中的键的存在。

  'before loop Dim excludedList As Object Set excludedList = CreateObject("Scripting.Dictionary") For i = 1 To rng1.Rows.Count excludedList.Add rng1.Cells(i, 1).value, 1 Next i '**************************************** 'in loop If excludedList.exists(rng2.Cells(i, 1).Value) Then rng2.Cells(i, 1).EntireRow.Hidden = True End If