sub1.删除工作表所有空行
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
sub2.删除工作表所有空列
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
sub3.删除选中单列包含指定字符的行
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, rng.Row) '表头行与选中区域开始行号的大值 last_row = rng.Row + rng.Rows.count - 1 '选中区域结束行号 first_col = rng.Column '选中区域开始列号 If rng.Row = 1 Then '选中单列整列 For i = last_row To title_row + 1 Step -1 '倒序循环 For Each j In arr '只要有一个符合,就删除 If Cells(i, first_col) Like j Then Rows(i).Delete Next Next ElseIf rng.Row > 1 Then '选中单列部分 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 If End Sub
举例
A列选中运行sub3后得到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, rng.row) '表头行与选中区域开始行号的大值 last_row = rng.row + rng.Rows.Count - 1 '选中区域结束行号 first_col = rng.column: tm = Timer '选中区域开始列号 If rng.row = 1 Then '选中单列整列 For i = title_row + 1 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 ElseIf rng.row > 1 Then '选中单列部分 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 End If If Not del_rng Is Nothing Then del_rng.Delete Debug.Print "删除完成用时:" & Format(Timer - tm, "0.00") '耗时 End Sub
sub4.删除选中单列不含指定字符的行
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, rng.Row) '表头行与选中区域开始行号的大值 last_row = rng.Row + rng.Rows.count - 1 '选中区域结束行号 first_col = rng.Column '选中区域开始列号 If rng.Row = 1 Then '选中单列整列 For i = last_row To title_row + 1 Step -1 '倒序循环 del_if = True '初始为删除 For Each j In arr '只要有一个符合,就不删除 If Cells(i, first_col) Like j Then del_if = False: Exit For Next '都不符合,删除 If del_if Then Rows(i).Delete Next ElseIf rng.Row > 1 Then '选中单列部分 For i = last_row To first_row Step -1 '倒序循环 del_if = True '初始为删除 For Each j In arr If Cells(i, first_col) Like j Then del_if = False: Exit For Next If del_if Then Rows(i).Delete Next End If End Sub
举例
A列选中运行sub4后得到C列效果
sub5.删除选中列重复的整行
对于选中多行多列区域,在一行中所有列的内容都重复,则删除该行,仅保留唯一一行,注意区分字母大小写
Sub 选中列去重() '适用单/多列选中、单/多列部分选中,去重删除整行 Dim rng As Range, dict As Object, first_row, last_row, first_col, last_col, i, j, res Set rng = Intersect(ActiveSheet.UsedRange, Selection) 'intersect语句避免选择整列造成无用计算 first_row = rng.Row '选中区域开始行号 last_row = first_row + rng.Rows.count - 1 '选中区域结束行号 first_col = rng.Column '选中区域开始列号 last_col = first_col + rng.Columns.count - 1 '选中区域结束列号 Set dict = CreateObject("scripting.dictionary") For i = last_row To first_row Step -1 '倒序循环,避免遗漏 res = "" For j = first_col To last_col res = res & CStr(Cells(i, j).Value) Next If Not dict.Exists(res) Then '字典键不存在,新增 dict(res) = "" Else Rows(i).Delete '删除行 End If Next End Sub
举例
多列去重前
选中A-D列,运行sub5,获得结果