Excel·VBA指定条件删除整行整列 |
您所在的位置：网站首页 › vba复制符合条件的行 › Excel·VBA指定条件删除整行整列 |
Excel·VBA指定条件删除整行整列
|
目录
1，删除工作表所有空行2，删除工作表所有空列3，删除选中单列包含指定字符的行举例3.1，改进版
4，删除选中单列不含指定字符的行举例
5，删除选中列重复的整行举例
6，删除选中列唯一的整行举例
1，删除工作表所有空行
Sub 删除工作表所有空行()
Dim first_row&, last_row&, i&
first_row = ActiveSheet.UsedRange.Row
last_row = first_row + ActiveSheet.UsedRange.Rows.count - 1
For i = last_row To first_row Step -1 '倒序循环
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete '删除行
End If
Next
End Sub
2，删除工作表所有空列
Sub 删除工作表所有空列()
Dim first_col&, last_col&, i&
first_col = ActiveSheet.UsedRange.Column
last_col = first_col + ActiveSheet.UsedRange.Columns.count - 1
For i = last_col To first_col Step -1 '倒序循环
If WorksheetFunction.CountA(Columns(i)) = 0 Then
Columns(i).Delete '删除列
End If
Next
End Sub
3，删除选中单列包含指定字符的行
Sub 删除选中单列包含指定字符的行()
'选中单列整列、单列部分都支持
Dim rng As Range, arr, first_row&, last_row&, first_col&, i&, j
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
'要删除的字符串数组，空值为删除空单元格，可使用模式匹配
arr = Array("*一", "*三", "*五")
title_row = 1 '表头行数，不执行删除
Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算
If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub '仅支持单列，多列则退出
'选中区域开始行号、结束行号、开始列号
first_row = WorksheetFunction.Max(title_row + 1, rng.row) '表头行与选中区域开始行号的大值
last_row = rng.row + rng.Rows.Count - 1: first_col = rng.column
For i = last_row To first_row Step -1 '倒序循环
For Each j In arr
'只要有一个符合，就删除
If Cells(i, first_col) Like j Then Rows(i).Delete
Next
Next
End Sub
举例
A列选中运行代码后得到C列效果 以上代码在删除数据量较大（几千行以上）的情况下速度较慢，参考《Excel·VBA按列拆分工作表、工作簿》采用先Union行再删除的方法可大幅提高速度。一般情况下数据量越大较原版代码提高速度越明显，经测试，删除10万行数据仅需1秒 同时，因为是最后一起删除整行，无续考虑删除行后导致行号变化，故采用正序循环 Sub 删除选中单列包含指定字符的行() '选中单列整列、单列部分都支持 Dim rng As Range, del_rng As Range, arr, first_row&, last_row&, first_col&, i&, j '--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数 '要删除的字符串数组，空值为删除空单元格，可使用模式匹配 arr = Array("1") title_row = 1 '表头行数，不执行删除 Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算 If rng.Columns.Count > 1 Then Debug.Print "仅支持单列": Exit Sub '仅支持单列，多列则退出 '选中区域开始行号、结束行号、开始列号 first_row = WorksheetFunction.Max(title_row + 1, rng.row) '表头行与选中区域开始行号的大值 last_row = rng.row + rng.Rows.Count - 1: first_col = rng.column For i = first_row To last_row For Each j In arr If CStr(Cells(i, first_col).Value) Like j Then If del_rng Is Nothing Then Set del_rng = Rows(i) Else Set del_rng = Union(del_rng, Rows(i)) End If End If Next Next If Not del_rng Is Nothing Then del_rng.Delete End Sub 4，删除选中单列不含指定字符的行 Sub 删除选中单列不含指定字符的行() '选中单列整列、单列部分都支持 Dim rng As Range, arr, first_row&, last_row&, first_col&, i&, j, del_if As Boolean '--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数 '要保留的字符串数组，空值为保留空单元格，可使用模式匹配 arr = Array("*一", "*三", "*五") title_row = 1 '表头行数，不执行删除 Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算 If rng.Columns.count > 1 Then Debug.Print "仅支持单列": Exit Sub '仅支持单列，多列则退出 '选中区域开始行号、结束行号、开始列号 first_row = WorksheetFunction.Max(title_row + 1, rng.row) '表头行与选中区域开始行号的大值 last_row = rng.row + rng.Rows.Count - 1: first_col = rng.column For i = last_row To first_row Step -1 '倒序循环 del_if = True '初始为删除 For Each j In arr If CStr(Cells(i, first_col).Value) Like j Then del_if = False: Exit For Next If del_if Then Rows(i).Delete Next End Sub 举例A列选中运行代码后得到C列效果 对于选中多行多列区域，在一行中所有列的内容都重复，则删除该行，注意区分字母大小写 当参数 delete_all = False 时，重复的保留1行；当参数 delete_all = True 时，重复的全部删除，详见举例 Sub 选中列去重() '适用单/连续多列选中、单/连续多列部分选中，删除选中区域内重复的整行 Dim rng As Range, del_rng As Range, dict1 As Object, dict2 As Object, delete_all As Boolean Dim first_row&, last_row&, first_col&, resize_c&, i&, res$, k delete_all = True '是否全部删除，False则重复的保留1行 Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算 '选中区域开始行号、结束行号、开始列号、选中列数 first_row = rng.row: last_row = first_row + rng.Rows.Count - 1 first_col = rng.column: resize_c = rng.Columns.Count Set dict1 = CreateObject("scripting.dictionary") Set dict2 = CreateObject("scripting.dictionary") For i = first_row To last_row temp = Cells(i, first_col).Resize(1, resize_c) temp = WorksheetFunction.Transpose(WorksheetFunction.Transpose(temp)) res = Join(temp, Chr(28)) '分隔符，最好为数据中不存在的字符 If Not dict1.Exists(res) Then '字典键不存在，新增 dict1(res) = i Else dict2(res) = "" If del_rng Is Nothing Then Set del_rng = Rows(i) Else Set del_rng = Union(del_rng, Rows(i)) End If End If Next If delete_all Then '重复的全部删除，加入dict1重复的行号 For Each k In dict1.keys If dict2.Exists(k) Then Set del_rng = Union(del_rng, Rows(dict1(k))) Next End If If Not del_rng Is Nothing Then del_rng.Delete '删除行 End Sub 举例《excel吧提问-多行多列重复数据筛选》 多列去重前 选中A-D列，运行代码，获得结果 delete_all = False '重复的保留1行
对于选中多行多列区域，在一行中所有列的内容拼接后为唯一的，则删除该行，注意区分字母大小写 Sub 选中列删除唯一行() '适用单/连续多列选中、单/连续多列部分选中，删除选中区域内唯一的整行 Dim rng As Range, del_rng As Range, dict1 As Object, dict2 As Object Dim title_row&, first_row&, last_row&, first_col&, resize_c&, i&, res$, k title_row = 2 '表头行数，不执行删除 Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算 '选中区域开始行号、结束行号、开始列号、选中列数 first_row = WorksheetFunction.Max(title_row + 1, rng.row) last_row = first_row + rng.Rows.Count - 1 first_col = rng.column: resize_c = rng.Columns.Count Set dict1 = CreateObject("scripting.dictionary") Set dict2 = CreateObject("scripting.dictionary") For i = first_row To last_row temp = Cells(i, first_col).Resize(1, resize_c) temp = WorksheetFunction.Transpose(WorksheetFunction.Transpose(temp)) res = Join(temp, Chr(28)) '分隔符，最好为数据中不存在的字符 If Not dict1.Exists(res) Then '字典键不存在，新增 dict1(res) = i Else dict2(res) = "" End If Next For Each k In dict1.keys If Not dict2.Exists(k) Then If del_rng Is Nothing Then Set del_rng = Rows(dict1(k)) Else Set del_rng = Union(del_rng, Rows(dict1(k))) End If End If Next If Not del_rng Is Nothing Then del_rng.Delete '删除行 End Sub 举例多列去重前 选中A-D列，运行代码，获得结果 |
【本文地址】
公司简介
联系我们
今日新闻 |
点击排行 |
|
推荐新闻 |
图片新闻 |
|
专题文章 |