在vba中隐藏行的更快的方法

是否有一个更快,或更实际的方式隐藏在列A中具有零值的所有表中的行? 我已经设置了多个macros来隐藏行,但这需要大约50-70秒来完成任何更快的方式?

Sub Macro14() Dim c As Range For Each c In Sheets("Main").Range("A200:A500") If c.value = 0 Then Sheets("Main").Rows(c.Row).Hidden = True Else Sheets("Main").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro15() Dim c As Range For Each c In Sheets("Elkhart East").Range("A50:A300") If c.value = 0 Then Sheets("Elkhart East").Rows(c.Row).Hidden = True Else Sheets("Elkhart East").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro16() Dim c As Range For Each c In Sheets("Tennessee").Range("A50:A300") If c.value = 0 Then Sheets("Tennessee").Rows(c.Row).Hidden = True Else Sheets("Tennessee").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro17() Dim c As Range For Each c In Sheets("Alabama").Range("A50:A300") If c.value = 0 Then Sheets("Alabama").Rows(c.Row).Hidden = True Else Sheets("Alabama").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro18() Dim c As Range For Each c In Sheets("North Carolina").Range("A50:A300") If c.value = 0 Then Sheets("North Carolina").Rows(c.Row).Hidden = True Else Sheets("North Carolina").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro19() Dim c As Range For Each c In Sheets("Pennsylvania").Range("A50:A300") If c.value = 0 Then Sheets("Pennsylvania").Rows(c.Row).Hidden = True Else Sheets("Pennsylvania").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro20() Dim c As Range For Each c In Sheets("Texas").Range("A50:A300") If c.value = 0 Then Sheets("Texas").Rows(c.Row).Hidden = True Else Sheets("Texas").Rows(c.Row).Hidden = False End If Next End Sub 

 Sub Macro21() Dim c As Range For Each c In Sheets("West Coast").Range("A50:A300") If c.value = 0 Then Sheets("West Coast").Rows(c.Row).Hidden = True Else Sheets("West Coast").Rows(c.Row).Hidden = False End If Next End Sub 

这应该以相当快的方式做到这一点:

 Sub test() Dim x As Variant, i As Long, j(1) As Long, rngVal As Variant, rnghide As Range, rngshow As Range, sht As Object For Each sht In ActiveWorkbook.Sheets(Array("Main", "Elkhart East", "Tennessee", "Alabama", "North Carolina", "Pennsylvania", "Texas", "West Coast")) Set rnghide = Nothing Set rngshow = Nothing If sht.Name = "Main" Then j(0) = 200 j(1) = 500 Else j(0) = 50 j(1) = 300 End If x = sht.Range("A1:A" & j(1)).Value For i = j(0) To j(1) If x(i, 1) = 0 Then If rnghide Is Nothing Then Set rnghide = sht.Rows(i) Else Set rnghide = Union(rnghide, sht.Rows(i)) Else If rngshow Is Nothing Then Set rngshow = sht.Rows(i) Else Set rngshow = Union(rngshow, sht.Rows(i)) End If Next rnghide.EntireRow.Hidden = True rngshow.EntireRow.Hidden = False Next End Sub 

它只是运行整个范围内的每张纸,并存储行显示/隐藏在单独的范围,然后改变那里的状态在一个步骤(1为显示和1为隐藏每张)

如果您有任何问题或有任何错误,请告诉我(现在无法testing)

使用数组:

 Sub t() Dim sheetArray() As Variant Dim ws&, finalRow&, startRow& Dim c As Range sheetArray = Array("Alabama", "North Carolina", "West Coast") For ws = LBound(sheetArray) To UBound(sheetArray) If sheetArray(ws) = "Main" Then startRow = 200 finalRow = 500 Else startRow = 50 finalRow = 300 End If For Each c In Sheets(sheetArray(ws)).Range("A" & startRow & ":A" & finalRow) If c.Value = 0 And Not IsEmpty(c) Then Sheets(sheetArray(ws)).Rows(c.Row).Hidden = True Else Sheets(sheetArray(ws)).Rows(c.Row).Hidden = False End If Next c Next ws End Sub 

只需添加到该arrays,它应该为你工作得更快一点。 如果您有大量的工作表,并且不想手动input到VBA代码中,则可以始终将该数组设置为表名的范围,然后从那里开始。 让我知道你是否需要帮助。

这也假定你不想只循环工作簿。 如果是这样,你可以做只为lBound()... For each ws in ActiveWorkbook而不是lBound()...

编辑:我添加了一些代码来检查工作表,所以它会正确地调整你的范围。

用这个 :

 For Each ws In ActiveWorkbook.Worksheets For Each c In ws.Range(IIf(ws.Name = "Main", "A200:A500", "A50:A300")) ws.Rows(c.Row).Hidden = c.Value = 0 Next Next 

如果要排除表格Raw,Main和Calendar:

 Dim untreatedSheet As Variant untreatedSheet = Array("Raw", "Main", "Calendar") For Each ws In ActiveWorkbook.Worksheets If Not (UBound(Filter(untreatedSheet, ws.Name)) > -1) Then For Each c In ws.Range("A50:A300") ws.Rows(c.Row).Hidden = c.Value = 0 Next End If Next 

这将工作,如果你select所有你想要筛选的工作表FIRST:

 Sub HideRows() Dim ws As Worksheet sAddress = "A:A" For Each ws In ActiveWindow.SelectedSheets ws.Range(sAddress).AutoFilter Field:=1, Criteria1:="<>0" Next ws End Sub