Excel·VBA指定条件删除整行整列

1，删除工作表所有空行

Sub 删除工作表所有空行()Dim first_row&, last_row&, i&first_row = ActiveSheet.UsedRange.Rowlast_row = first_row + ActiveSheet.UsedRange.Rows.count - 1For i = last_row To first_row Step -1   '倒序循环If WorksheetFunction.CountA(Rows(i)) = 0 ThenRows(i).Delete  '删除行End IfNext
End Sub

2，删除工作表所有空列

Sub 删除工作表所有空列()Dim first_col&, last_col&, i&first_col = ActiveSheet.UsedRange.Columnlast_col = first_col + ActiveSheet.UsedRange.Columns.count - 1For i = last_col To first_col Step -1   '倒序循环If WorksheetFunction.CountA(Columns(i)) = 0 ThenColumns(i).Delete  '删除列End IfNext
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.columnFor i = last_row To first_row Step -1  '倒序循环For Each j In arr'只要有一个符合，就删除If Cells(i, first_col) Like j Then Rows(i).DeleteNextNext
End Sub

举例

A列选中运行代码后得到C列效果

3.1，改进版

以上代码在删除数据量较大（几千行以上）的情况下速度较慢，参考《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.columnFor i = first_row To last_rowFor Each j In arrIf CStr(Cells(i, first_col).Value) Like j ThenIf del_rng Is Nothing ThenSet del_rng = Rows(i)ElseSet del_rng = Union(del_rng, Rows(i))End IfEnd IfNextNextIf 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.columnFor i = last_row To first_row Step -1  '倒序循环del_if = True    '初始为删除For Each j In arrIf CStr(Cells(i, first_col).Value) Like j Then del_if = False: Exit ForNextIf del_if Then Rows(i).DeleteNext
End Sub

举例

A列选中运行代码后得到C列效果

5，删除选中列重复的整行

对于选中多行多列区域，在一行中所有列的内容都重复，则删除该行，注意区分字母大小写
当参数 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 BooleanDim first_row&, last_row&, first_col&, resize_c&, i&, res$, kdelete_all = True   '是否全部删除，False则重复的保留1行Set rng = Intersect(ActiveSheet.UsedRange, Selection)  'intersect语句避免选择整列造成无用计算'选中区域开始行号、结束行号、开始列号、选中列数first_row = rng.row: last_row = first_row + rng.Rows.Count - 1first_col = rng.column: resize_c = rng.Columns.CountSet dict1 = CreateObject("scripting.dictionary")Set dict2 = CreateObject("scripting.dictionary")For i = first_row To last_rowtemp = 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) = iElsedict2(res) = ""If del_rng Is Nothing ThenSet del_rng = Rows(i)ElseSet del_rng = Union(del_rng, Rows(i))End IfEnd IfNextIf delete_all Then  '重复的全部删除，加入dict1重复的行号For Each k In dict1.keysIf dict2.Exists(k) Then Set del_rng = Union(del_rng, Rows(dict1(k)))NextEnd IfIf Not del_rng Is Nothing Then del_rng.Delete  '删除行
End Sub

举例

《excel吧提问-多行多列重复数据筛选》

多列去重前

选中A-D列，运行代码，获得结果

delete_all = False  '重复的保留1行

delete_all = True  '重复的全部删除

6，删除选中列唯一的整行

对于选中多行多列区域，在一行中所有列的内容拼接后为唯一的，则删除该行，注意区分字母大小写

Sub 选中列删除唯一行()'适用单/连续多列选中、单/连续多列部分选中，删除选中区域内唯一的整行Dim rng As Range, del_rng As Range, dict1 As Object, dict2 As ObjectDim title_row&, first_row&, last_row&, first_col&, resize_c&, i&, res$, ktitle_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 - 1first_col = rng.column: resize_c = rng.Columns.CountSet dict1 = CreateObject("scripting.dictionary")Set dict2 = CreateObject("scripting.dictionary")For i = first_row To last_rowtemp = 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) = iElsedict2(res) = ""End IfNextFor Each k In dict1.keysIf Not dict2.Exists(k) ThenIf del_rng Is Nothing ThenSet del_rng = Rows(dict1(k))ElseSet del_rng = Union(del_rng, Rows(dict1(k)))End IfEnd IfNextIf Not del_rng Is Nothing Then del_rng.Delete  '删除行
End Sub

举例