隐藏空数据图表的标题行
我有一系列显示Vlookups值的工作表。 我创build了一个隐藏表中的所有空行，但我不确定如何隐藏标题行，如果它下面的所有行都隐藏。 对于隐藏行函数，我使用颜色和四列中的值来确定是否使用具有行数的for循环隐藏行。 行隐藏代码如图所示。
Public Sub RowHide() Application.ScreenUpdating = False 'variable declarations Dim ws As Worksheet 'column number ref. Dim r As Integer r = 6 Dim num As Integer 'To go through Each WS For Each ws In ActiveWorkbook.Worksheets Dim i As Integer Dim plusVar As Integer Let plusVar = 2 'To go through the rows With ws For i = 1 To 200 .Rows(i).AutoFit If (.Cells(i, r).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r - 1).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r + 1).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r + plusVar).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then .Rows(i).Hidden = True End If End If End If End If On Error Resume Next Next i End With On Error Resume Next 'adjusting the target column for each Ws r = r - 1 If r = 4 Then r = 3 plusVar = 3 End If Next ws Application.ScreenUpdating = True End Sub 此代码完美工作。 下一步是有一个子将检查每个“标题”下的行是否全部隐藏（如果有任何数据存在表中，我不想隐藏标题），如果是这样，然后隐藏行它的标题。
这是表的格式：
AB [Status] **TITLE** BlankCell Not Hidden (what I want to hide) Category1 BlankCell Row Hidden Category2 BlankCell Row Hidden Category3 BlankCell Row Hidden Category4 BlankCell Row Hidden Blank Cell BlankCell Row Not hidden
其他可能性的例子：
AB [Status] **TITLE** BlankCell Not Hidden (Don't want to hide it in this scenario) Category1 BlankCell Row Hidden Category2 BlankCell Row Hidden Category3 BlankCell Row Hidden Category4 Value Row not hidden BlankCell BlankCell Not hidden (was trying to use this to determine range of what to hide)
这是我迄今为止的标题行隐藏子代码：
Public Sub UnusedTitleHide() Dim ws As Worksheet Dim rw As Range Dim LastRow As Long Dim i As Integer Dim b As Integer For Each ws In ActiveWorkbook.Worksheets With ws LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Dim firstRow As Long Dim endRng As Range Dim endRow As Long Dim hide As Boolean Dim hiC As Integer Dim hiT As Integer hiC = 0 For i = 1 To LastRow If (.Cells(i, 1).Value <> 0 And .Cells(i, 1).Text <> "") Then Set endRng = .Cells(i, 1).End(xlUp).Offset(1) Let endRow = endRng.Row End If b = i hiC = 0 Do While b <= endRow hiT = endRow - b If .Rows(b).Hidden = True Then hiC = hiC + 1 End If b = b + 1 Loop If hiC = hiT Then If i - 1 <> 0 Then If (.Cells(i - 1, 1).Text = "") And hiC = hiT Then .Rows(i).Hidden = True End If End If End If On Error Resume Next Next i End With Next ws End Sub
编辑：澄清工作表的格式。
AB [Status] **TITLE** BlankCell Not Hidden (what I want to hide as no categories have values.) Category1 BlankCell Row Hidden Category2 BlankCell Row Hidden Category3 BlankCell Row Hidden Category4 BlankCell Row Hidden Blank Cell BlankCell Row Not hidden **TITLE** BlankCell Row Not hidden (Don't want to hide this row as a category has values) Category1 Text/Num Row Not Hidden Category2 BlankCell Row Hidden Category3 Text/Num Row Not Hidden Category4 BlankCell Row Hidden
一种方法是检查数据表中的每一行。 如果任何行不隐藏（即有数据），那么不要隐藏标题行。 否则，如果所有行都被隐藏，则隐藏标题行。 假设你的标题行是第一行：
For Each ws In ActiveWorkbook.Worksheets With ws LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row For i = LastRow To 2 Step (-1) 'from the end to one below the title row If .Rows(i).Hidden = True Then 'Hidden Row. Keep checking for data ElseIf .Rows(i).Hidden = False Then 'Data is present, no need to hide title GoTo NextSht End If Next i 'No Data was found, so hide the title row .Rows(1).Hidden = True NextSht: End With Next ws
更好的编辑：下面的代码查找标题行。 它循环到下一个未隐藏的行，如果它是空的，隐藏标题行。 让我知道这个是否适合你：
For Each Cell In rng If Cell.Font.Bold = True Then Set TitleCell = Cell i = 1 Do While Cell.Offset(i, 0).Rows.EntireRow.Hidden = True i = i + 1 Loop If IsEmpty(Cell.Offset(i, 0)) = True Then TitleCell.Rows.EntireRow.Hidden = True End If End If 'Next Cell Next Cell
编辑：修改后的代码将通过一组单元格，如果它们由一个空行分隔，并规定之间没有空白。 它进一步假定根据在“类别”的右边相邻单元格中是否有值来隐藏这些线条。
Public Sub UnusedTitleHide() Dim ws As Worksheet Dim LastRow As Long Dim LocalLastRow As Long Dim LocalFirstCell, LocalLastCell, LocalCells As Range On Error GoTo ErrHandle WSCount = ActiveWorkbook.Worksheets.Count 'I was getting errors when using the "For Each ws" loop. 'It failed to move onto the next worksheet, for some reason For W = 1 To WSCount Set ws = ActiveWorkbook.Sheets(W) With ws 'A more reliable way of finding the last row LastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row 'Unhide everything so the End function doesn't skip cells. For i = 1 To LastRow Rows(i).Hidden = False Next i 'Start with the first cell Set LocalFirstCell = .Cells(1, 1).Offset(1, 0) Do While LocalLastRow < LastRow 'Last cell is at the end of the section Set LocalLastCell = LocalFirstCell.End(xlDown) 'Set is made up of cells between first and last Set LocalCells = Range(LocalFirstCell, LocalLastCell) For Each Cell In LocalCells If IsEmpty(Cell.Offset(0, 1)) = True Then Cell.Rows.EntireRow.Hidden = True End If Next Cell For Each Cell In LocalCells If Cell.Rows.EntireRow.Hidden = True Then 'HiddenRow. Keep Checking for data ElseIf Cell.Rows.EntireRow.Hidden = False Then 'Data is present, no need to hide title GoTo NextSet End If Next Cell 'No Data Was found, so hide the title row LocalFirstCell.Offset(-1, 0).Rows.EntireRow.Hidden = True NextSet: LocalLastRow = LocalLastCell.Row Set LocalFirstCell = LocalLastCell.End(xlDown) 'Catch if the End function goes to the end of the sheet If LocalFirstCell.Row = 1048576 Then GoTo NextWorksheet Else 'Otherwise keep on looping Set LocalFirstCell = LocalFirstCell.Offset(1, 0) End If Loop NextWorksheet: End With Next W ErrHandle: 'Triggered by the Find function not finding anything If Err.Number = 91 Then MsgBox ("No Data in " & ws.Name) Resume NextWorksheet End If End Sub
虽然这可能适用于你当前的情况，正如@Mooseman所build议的，最好隐藏标题行，而隐藏所有其他行。
因为只有当你到达最后一个if语句时，行才被隐藏，因为在你的嵌套ifs中，任何其他的都不会隐藏行并留下标题，所以：
If (.Cells(i, r).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r - 1).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r + 1).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then If (.Cells(i, r + plusVar).Value = 0 Or .Cells(i, r).Text = "") And .Cells(i, r).Interior.ColorIndex < 0 Then .Rows(i).Hidden = True Else Titlesvisable = 1 End If Else Titlesvisable = 1 End If Else Titlesvisable = 1 End If Else Titlesvisable = 1 End If
这是基于E. Merckx的“更好的编辑”的代码的最终版本，
Public Sub UnusedTitleFinal() Dim ws As Worksheet Dim Cell As Range Dim Rng As Range Dim lastRow As Long Dim rngString As String Dim TitleCell As Range Dim i As Integer 'Iterating through each worksheet For Each ws In ActiveWorkbook.Worksheets With ws 'Finding and setting the range to check the cells lastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row rngString = "A" & "6" & ":" & "A" & lastRow + 1 Set Rng = .Range(rngString) For Each Cell In Rng.Cells If Cell.Font.Bold = True Then Set TitleCell = Cell i = 1 Do While Cell.Offset(i, 0).Rows.EntireRow.Hidden = True i = i + 1 Loop If IsEmpty(Cell.Offset(i, 0)) = True Then TitleCell.Rows.EntireRow.Hidden = True End If End If 'Next Cell Next Cell End With Next ws End Sub