求助大神，用VBA代码将未被筛选出的数据行删除！

lhteee

求助大神，用VBA代码将未被筛选出的数据行删除！

常识了很多，做不到，求助大神！见示例
示例.rar (15.42 KB, 下载次数: 7)

2024-12-21 12:45 上传

点击文件名下载附件

taller

1. Sub Demo()
   
2.     Dim delRng As Range
   
3.     Set c = Sheets(1).UsedRange
   
4.     For i = 1 To c.Rows.Count
   
5.         If Cells(i, 1).RowHeight = 0 Then
   
6.             Set delRng = GetMergeRng(delRng, Cells(i, 1))
   
7.         End If
   
8.     Next
   
9.     If Not delRng Is Nothing Then
   
10.         delRng.EntireRow.Delete
    
11.     End If
    
12. End Sub
    
13. 
    
14. Function GetMergeRng(ByRef RngAll As Range, ByRef RngSub As Range) As Range
    
15.     If RngAll Is Nothing Then
    
16.         Set RngAll = RngSub
    
17.     ElseIf Not RngSub Is Nothing Then
    
18.         Set RngAll = Application.Union(RngAll, RngSub)
    
19.     End If
    
20.     Set GetMergeRng = RngAll
    
21. End Function

复制代码

gwjkkkkk

gwjkkkkk

。。。。。。。。。。。。。。

lhteee

taller 发表于 2024-12-21 13:31

谢谢！需要多次执行才能得到想要的效果，并且最后还有些行无法删除。谢谢！

lhteee

gwjkkkkk 发表于 2024-12-21 14:13
。。。。。。。。。。。。。。

换了一种思路，达到目的，牛牛牛！！！

lhteee

感谢各位大神，最终修改为以下代码：

1. Sub 拷贝筛选表格数据()
   
2.     Dim rngData As Range
   
3.     Dim NewSheet As Worksheet
   
4.    
   
5.     Set rngData = ActiveSheet.[A1].CurrentRegion
   
6.     If Not ActiveSheet.AutoFilterMode Then Exit Sub
   
7.     Set NewSheet = Worksheets.Add(After:=ActiveSheet)
   
8.         NewSheet.Name = "拷贝筛选"
   
9.         rngData.Copy Worksheets("拷贝筛选").[A1]
   
10. 
    
11.     Beep
    
12. End Sub
    

复制代码

作成加载宏了，谢谢！

lhteee

这个代码可以完美做到。

1. Sub 删除隐藏行()
   
2.     Dim rng As Range
   
3.     Dim i As Long
   
4.     Application.ScreenUpdating = False ' 关闭屏幕更新以加快宏运行速度
   
5.     Set rng = ActiveSheet.UsedRange ' 设置范围为当前工作表的已使用范围
   
6.      ' 从下往上遍历行，以避免因隐藏行导致的行号变化问题
   
7.     For i = rng.Rows.Count To 1 Step -1
   
8.         If Rows(i).RowHeight = 0 Then ' 如果行高为零，即隐藏行
   
9.             Rows(i).Delete ' 删除隐藏行
   
10.         End If
    
11.     Next i
    
12.     Application.ScreenUpdating = True ' 恢复屏幕更新
    
13. End Sub
    
14. 
    

复制代码

ykcbf1100

lhteee 发表于 2024-12-21 21:55
这个代码可以完美做到。

你这个代码只能在数据行数少的情况下使用。如果行数上万就会卡住。

ykcbf1100

不用那么麻烦，数据直接复制过去就行。

关键代码就一句。