亚洲乱码中文字幕综合,中国熟女仑乱hd,亚洲精品乱拍国产一区二区三区,一本大道卡一卡二卡三乱码全集资源,又粗又黄又硬又爽的免费视频

Excel?VBA指定條件刪除整行整列的實現(xiàn)

 更新時間:2023年06月05日 08:42:49   作者:薛定諤_51  
本文主要介紹了Excel?VBA指定條件刪除整行整列的實現(xiàn),文中通過示例代碼介紹的非常詳細(xì),對大家的學(xué)習(xí)或者工作具有一定的參考學(xué)習(xí)價值,需要的朋友們下面隨著小編來一起學(xué)習(xí)學(xué)習(xí)吧

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   '倒序循環(huán)
        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   '倒序循環(huán)
        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
'--------------------參數(shù)填寫:arr,指定條件字符串?dāng)?shù)組;title_row,表頭行數(shù)
    '要刪除的字符串?dāng)?shù)組,空值為刪除空單元格,可使用模式匹配
    arr = Array("*一", "*三", "*五")
    title_row = 1        '表頭行數(shù),不執(zhí)行刪除
    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)  '表頭行與選中區(qū)域開始行號的大值
    last_row = rng.Row + rng.Rows.count - 1  '選中區(qū)域結(jié)束行號
    first_col = rng.Column  '選中區(qū)域開始列號
    
    If rng.Row = 1 Then  '選中單列整列
        For i = last_row To title_row + 1 Step -1  '倒序循環(huán)
            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  '倒序循環(huán)
            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列效果

在這里插入圖片描述

改進(jìn)版

以上代碼在刪除數(shù)據(jù)量較大(幾千行以上)的情況下速度較慢,參考《Excel·VBA按列拆分工作表、工作簿》采用先Union行再刪除的方法可大幅提高速度。一般情況下數(shù)據(jù)量越大較原版代碼提高速度越明顯,經(jīng)測試,刪除10萬行數(shù)據(jù)僅需1秒
同時,因為是最后一起刪除整行,無續(xù)考慮刪除行后導(dǎo)致行號變化,故采用正序循環(huán)

Sub 刪除選中單列包含指定字符的行()
    '選中單列整列、單列部分都支持
    Dim rng As Range, del_rng As Range, arr, first_row&, last_row&, first_col&, i&, j
'--------------------參數(shù)填寫:arr,指定條件字符串?dāng)?shù)組;title_row,表頭行數(shù)
    '要刪除的字符串?dāng)?shù)組,空值為刪除空單元格,可使用模式匹配
    arr = Array("1")
    title_row = 1        '表頭行數(shù),不執(zhí)行刪除
    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)  '表頭行與選中區(qū)域開始行號的大值
    last_row = rng.row + rng.Rows.Count - 1  '選中區(qū)域結(jié)束行號
    first_col = rng.column: tm = Timer    '選中區(qū)域開始列號
    
    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
'--------------------參數(shù)填寫:arr,指定條件字符串?dāng)?shù)組;title_row,表頭行數(shù)
    '要保留的字符串?dāng)?shù)組,空值為保留空單元格,可使用模式匹配
    arr = Array("*一", "*三", "*五")
    title_row = 1        '表頭行數(shù),不執(zhí)行刪除
    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)  '表頭行與選中區(qū)域開始行號的大值
    last_row = rng.Row + rng.Rows.count - 1  '選中區(qū)域結(jié)束行號
    first_col = rng.Column  '選中區(qū)域開始列號
    
    If rng.Row = 1 Then   '選中單列整列
        For i = last_row To title_row + 1 Step -1  '倒序循環(huán)
            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  '倒序循環(huán)
            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.刪除選中列重復(fù)的整行

對于選中多行多列區(qū)域,在一行中所有列的內(nèi)容都重復(fù),則刪除該行,僅保留唯一一行,注意區(qū)分字母大小寫

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     '選中區(qū)域開始行號
    last_row = first_row + rng.Rows.count - 1  '選中區(qū)域結(jié)束行號
    first_col = rng.Column  '選中區(qū)域開始列號
    last_col = first_col + rng.Columns.count - 1  '選中區(qū)域結(jié)束列號
    Set dict = CreateObject("scripting.dictionary")
    
    For i = last_row To first_row Step -1   '倒序循環(huán),避免遺漏
        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,獲得結(jié)果

在這里插入圖片描述

到此這篇關(guān)于Excel VBA指定條件刪除整行整列的實現(xiàn)的文章就介紹到這了,更多相關(guān)Excel VBA指定條件刪除內(nèi)容請搜索腳本之家以前的文章或繼續(xù)瀏覽下面的相關(guān)文章希望大家以后多多支持腳本之家!

相關(guān)文章

最新評論