Excel VBA指定条件删除整行整列的实现

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

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

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

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

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

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