跳到主要內容

如何過濾列表並刪除Excel中其餘的隱藏行或可見行?

對於過濾列表,您可能需要刪除隱藏或可見行,以便僅保留有用數據。 在本文中,我們將向您展示刪除Excel中已過濾列表的其餘隱藏或可見行的方法。

使用VBA代碼刪除活動工作表中的隱藏行
通過選擇所有可見單元格刪除過濾列表的可見行
使用Kutools for Excel輕鬆刪除過濾列表的隱藏或可見行


使用VBA代碼刪除活動工作表中的隱藏行

本節將向您展示VBA代碼,以刪除活動工作表中的隱藏行。 請執行以下操作。

1.激活需要刪除隱藏行的工作表,然後按 其他 + F11 同時打開 Microsoft Visual Basic for Applications 窗口。

2.在“ Microsoft Visual Basic for Applications”窗口中,單擊“ 插入 > 模塊。 然後將下面的VBA代碼複製並粘貼到“模塊”窗口中。

VBA代碼:刪除隱藏的行

Sub RemoveHiddenRows()
	Dim xRow As Range
	Dim xRg As Range
	Dim xRows As Range
	On Error Resume Next
	Set xRows = Intersect(ActiveSheet.Range("A:A").EntireRow, ActiveSheet.UsedRange)
	If xRows Is Nothing Then Exit Sub
		For Each xRow In xRows.Columns(1).Cells
			If xRow.EntireRow.Hidden Then
				If xRg Is Nothing Then
					Set xRg = xRow
				Else
					Set xRg = Union(xRg, xRow)
				End If
			End If
		Next
		If Not xRg Is Nothing Then
			MsgBox xRg.Count & " hidden rows have been deleted", , "Kutools for Excel"
			xRg.EntireRow.Delete
		Else
			MsgBox "No hidden rows found", , "Kutools for Excel"
		End If
	End Sub

3。 按 F5 鍵來運行代碼。 如果活動工作表中有隱藏行,則運行代碼後,將彈出一個對話框,告訴您已刪除了多少個隱藏行。 點擊 OK 按鈕刪除隱藏的行。 看截圖:

doc刪除休息1

否則,運行代碼後,您將獲得以下對話框。

doc刪除休息1

備註:上面的VBA代碼不僅可以刪除過濾列表的隱藏行,還可以刪除您之前手動隱藏的隱藏行。


通過選擇所有可見單元格功能刪除過濾列表的可見行

要刪除過濾列表的可見行,請執行以下操作。

1.選擇所有過濾出的行,然後按 F5 鍵打開 轉到 對話框,然後單擊 特別 按鈕。 看截圖:

doc刪除休息1

2。 在裡面 去特別 對話框,檢查 僅可見細胞 選項,然後單擊 OK 按鈕。

doc刪除休息1

3.現在,所有可見行均被選中,右鍵單擊所選內容,然後單擊“確定”。 刪除行.

doc刪除休息1

到目前為止,所有可見行均已從過濾列表中刪除。


使用Kutools for Excel輕鬆刪除過濾列表的隱藏或可見行

對於許多Excel用戶來說,以上兩種方法可能不是理想的解決方案,在這裡我們為您介紹一個方便的工具。 隨著 刪除隱藏(可見)行和列 的效用 Excel的Kutools,您可以輕鬆刪除Excel中所選範圍/工作表,活動工作表或所有工作表中的隱藏行。

申請前 Excel的Kutools首先下載並安裝.

1.如果您只想刪除過濾列表的隱藏或可見行,請手動選擇過濾範圍,然後單擊 庫工具 > 刪除 > 刪除隱藏(可見)行和列。 看截圖:

2。 在裡面 刪除隱藏(可見)行和列 對話框中,保留 在選定範圍內 選中 在看 下拉列表(您可以根據需要選擇其他選項),然後選中 在選項 刪除類型 部分,並在 詳細類型 部分,檢查 可見行 or 隱藏的行 您需要的選項。 最後點擊 OK 按鈕。

3.然後會彈出一個對話框,告訴您已刪除了多少行,請單擊 OK 按鈕。

  如果您想免費試用(30天)此實用程序, 請點擊下載,然後按照上述步驟進行操作。


使用Kutools for Excel刪除過濾列表的隱藏或可見行

最佳辦公生產力工具

熱門特色: 尋找、突出顯示或識別重複項   |  刪除空白行   |  合併列或儲存格而不遺失數據   |   沒有公式的回合 ...
超級查詢: 多條件VLookup    多值VLookup  |   跨多個工作表的 VLookup   |   模糊查詢 ....
高級下拉列表: 快速建立下拉列表   |  依賴下拉列表   |  多選下拉列表 ....
欄目經理: 新增特定數量的列  |  移動列  |  切換隱藏列的可見性狀態  |  比較範圍和列 ...
特色功能: 網格焦點   |  設計圖   |   大方程式酒吧    工作簿和工作表管理器   |  資源庫 (自動文字)   |  日期選擇器   |  合併工作表   |  加密/解密單元格    按清單發送電子郵件   |  超級濾鏡   |   特殊過濾器 (過濾粗體/斜體/刪除線...)...
前 15 個工具集12 文本 工具 (添加文本, 刪除字符,...)   |   50+ 圖表 類型 (甘特圖,...)   |   40+ 實用 公式 (根據生日計算年齡,...)   |   19 插入 工具 (插入二維碼, 從路徑插入圖片,...)   |   12 轉化 工具 (數字到單詞, 貨幣兌換,...)   |   7 合併與拆分 工具 (高級合併行, 分裂細胞,...)   |   ... 和更多

使用 Kutools for Excel 增強您的 Excel 技能,體驗前所未有的效率。 Kutools for Excel 提供了 300 多種進階功能來提高生產力並節省時間。  點擊此處獲取您最需要的功能...

kte選項卡201905


Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
Comments (7)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi this VBA code is awesome useful.
This comment was minimized by the moderator on the site
Thanks for the info. This has been instructive. Please is there a way to filter and delete for specific numbers in rows of up to 1 million? Can the code above be modified to do so?
This comment was minimized by the moderator on the site
Hi,
Sorry did not test the code in such huge row data. Maybe you can make a copy of your data and test if the code can work.
This comment was minimized by the moderator on the site
VBA code to Delete hidden rows worked perfectly with no fiddling. THANK YOU!!
This comment was minimized by the moderator on the site
Feedback re: the macro for hidden row deletions - this takes too long to run on 900k rows to be useful. 2+ hours on an OC'd Threadripper 1950X and still running (had to end task). Any way to optimize it to use multiple cores or is this a VBA limitation?
This comment was minimized by the moderator on the site
Hi,
The code has been optimized. Please have a try. Thank you for your comment.

Sub RemoveHiddenRows()
Dim xFlag As Boolean
Dim xStr, xTemp As String
Dim xDiv, xMod As Long
Dim I, xCount, xRows As Long
Dim xRg, xCell, xDRg As Range
Dim xArr() As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Set xRg = Intersect(ActiveSheet.Range("A:A").EntireRow, ActiveSheet.UsedRange)
If xRg Is Nothing Then Exit Sub
xRows = xRg.Rows.Count
Set xRg = xRg(1)
xFlag = True
xTemp = ""
xCount = 0
For I = 1 To xRows
Set xCell = xRg.Offset(I - 1, 0)
Do While xFlag
If xCell.EntireRow.Hidden Then
xStr = xCell.Address
xFlag = False
Else
GoTo Ctn
End If
Loop
If xCell.EntireRow.Hidden Then
xTemp = xStr & "," & xCell.Address
End If
If Len(xTemp) > 171 Then
xCount = xCount + 1
ReDim Preserve xArr(1 To xCount)
xArr(xCount) = xStr
xStr = xCell.Address
Else
xStr = xTemp
End If
Ctn:
Next
xCount = xCount + 1
ReDim Preserve xArr(1 To xCount)
xArr(xCount) = xStr
For I = xCount To 1 Step -1
If I = 1 Then
xStr = Mid(xArr(I), InStr(xArr(I), ",") + 1, Len(xArr(I)) - InStr(xArr(I), ","))
Else
xStr = xArr(I)
End If
If xDRg Is Nothing Then
Set xDRg = Range(xStr)
Else
Set xDRg = Union(xDRg, Range(xStr))
End If
If (Len(xDRg.Address) >= 244) Or (xCount = 1) Then
xDRg.EntireRow.Delete
Set xDRg = Nothing
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Awesome, thank you! Will review at my next opportunity / need for this and reply back.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations