我只需要在我的資料集上過濾/顯示可見單元格上的資料。
AutoFilter 的使用非常快,但它有一個缺點,它會顯示相應標準上的任何隱藏行。.
雖然我在下面的代碼中使用了陣列和應用程式優化,但是如果范圍開始變大,它會變得非常慢。
只有 100 行,它在 1.12 秒完成,1000 行它在 117.47 秒完成!
在此之前,我感謝您的所有支持。
Option Explicit
Option Compare Text
Sub Filter_on_Visible_Cells_Only()
Dim t: t = Timer
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range
Dim arr1() As Variant, arr2() As Variant
Dim i As Long, HdRng As Range
Dim j As Long, k As Long
SpeedOn
Set ws1 = ThisWorkbook.ActiveSheet
Set ws2 = ThisWorkbook.Sheets("Platforms")
Set rng1 = ws1.Range("D3:D" & ws1.Cells(Rows.Count, "D").End(xlUp).Row) 'ActiveSheet
Set rng2 = ws2.Range("B3:B" & ws2.Cells(Rows.Count, "A").End(xlUp).Row) 'Platforms
arr1 = rng1.Value2
arr2 = rng2.Value2
For i = 1 To UBound(arr1)
If ws1.Rows(i 2).Hidden = False Then '(i 2) because Data starts at Row_3
For j = LBound(arr1) To UBound(arr1)
For k = LBound(arr2) To UBound(arr2)
If arr1(j, 1) <> arr2(k, 1) Then
addToRange HdRng, ws1.Range("A" & i 2) 'Make a union range of the rows NOT matching criteria...
End If
Next k
Next j
End If
Next i
If Not HdRng Is Nothing Then HdRng.EntireRow.Hidden = True 'Hide not matching criteria rows.
Speedoff
Debug.Print "Filter_on_Visible_Cells, in " & Round(Timer - t, 2) & " sec"
End Sub
Private Sub addToRange(rngU As Range, rng As Range)
If rngU Is Nothing Then
Set rngU = rng
Else
Set rngU = Union(rngU, rng)
End If
End Sub
Sub SpeedOn()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
End Sub
Sub Speedoff()
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
uj5u.com熱心網友回復:
好的,如果你想使用它,你也必須使用帶有 vba 的自動過濾器。沒有通過 excel UI 使用自動過濾器觸發的事件(除非您使用隱藏作業表中的公式的一些幫助,如此處所述Link)。
但是如果你想在 vba 中使用它,你可以簡單地使用它,這應該會有所幫助,如果我在 167 個單元格上嘗試它,它的作業速度非常快:
Sub m()
Dim rngTemp As Range
For Each c In Range("a1:a167")
If c.EntireRow.Hidden Then
If rngTemp Is Nothing Then
Set rngTemp = c
Else
Set rngTemp = Union(rngTemp, c)
End If
End If
Next c
Range("A1:A167").AutoFilter Field:=1, Criteria1:="10" ' your autofilter values
rngTemp.EntireRow.Hidden = False
End Sub
uj5u.com熱心網友回復:
比較值使用Application.Match
Sub Filter_on_Visible_Cells_Only()
Dim t: t = Timer
Dim sws As Worksheet, srg As Range
Dim dws As Worksheet, drg As Range, dCell As Range, hdrg As Range
SpeedOn
Set sws = ThisWorkbook.Sheets("Platforms")
Set srg = sws.Range("B3", sws.Cells(sws.Rows.Count, "B").End(xlUp))
Set dws = ThisWorkbook.ActiveSheet
Set drg = dws.Range("D3", dws.Cells(dws.Rows.Count, "D").End(xlUp))
Set drg = drg.SpecialCells(xlCellTypeVisible)
For Each dCell In drg.Cells
If IsError(Application.Match(drg.Value, srg, 0)) Then
addToRange hdrg, dCell
End If
Next dCell
If Not hdrg Is Nothing Then hdrg.EntireRow.Hidden = True
Speedoff
Debug.Print "Filter_on_Visible_Cells, in " & Round(Timer - t, 2) & " sec"
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/524483.html
標籤:数组擅长vba可见的
