幽默哥 發表於 2023-6-5 08:42:49

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

<div id="navCategory"><h5 class="catalogue">目录</h5><ul class="first_class_ul"><li><a href="#_label0">sub1.删除工作表所有空行</a></li><li><a href="#_label1">sub2.删除工作表所有空列</a></li><li><a href="#_label2">sub3.删除选中单列包含指定字符的行</a></li><ul class="second_class_ul"><li><a href="#_lab2_2_0">改进版</a></li></ul><li><a href="#_label3">sub4.删除选中单列不含指定字符的行</a></li><ul class="second_class_ul"></ul><li><a href="#_label4">sub5.删除选中列重复的整行</a></li><ul class="second_class_ul"></ul></ul></div><p class="maodian"><a name="_label0"></a></p><h2>sub1.删除工作表所有空行</h2>
<div class="jb51code"><pre class="brush:vb;">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
</pre></div>
<p class="maodian"><a name="_label1"></a></p><h2>sub2.删除工作表所有空列</h2>
<div class="jb51code"><pre class="brush:vb;">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
</pre></div>
<p class="maodian"><a name="_label2"></a></p><h2>sub3.删除选中单列包含指定字符的行</h2>
<div class="jb51code"><pre class="brush:vb;">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 &gt; 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 &gt; 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
</pre></div>
<p>举例</p>
<p><strong>A列选中运行sub3后得到C列效果</strong></p>
<p style="text-align:center"><img alt="在这里插入图片描述" src="https://img.jbzj.com/file_images/article/202301/2023012910460851.jpg" /></p>
<p class="maodian"><a name="_lab2_2_0"></a></p><h3>改进版</h3>
<p>以上代码在删除数据量较大（几千行以上）的情况下速度较慢，参考《<a href="https://www.jb51.net/article/273621.htm" target="_blank">Excel&middot;VBA按列拆分工作表、工作簿</a>》采用先Union行再删除的方法可大幅提高速度。<strong>一般情况下数据量越大较原版代码提高速度越明显，经测试，删除10万行数据仅需1秒</strong><br />同时，因为是最后一起删除整行，无续考虑删除行后导致行号变化，故采用正序循环</p>
<div class="jb51code"><pre class="brush:vb;">Sub 删除选中单列包含指定字符的行()
    '选中单列整列、单列部分都支持
    Dim rng As Range, del_rng As Range, arr, first_row&amp;, last_row&amp;, first_col&amp;, i&amp;, j
'--------------------参数填写：arr，指定条件字符串数组；title_row，表头行数
    '要删除的字符串数组，空值为删除空单元格，可使用模式匹配
    arr = Array("1")
    title_row = 1      '表头行数，不执行删除
    Set rng = Intersect(ActiveSheet.UsedRange, Selection)'intersect语句避免选择整列造成无用计算
    If rng.Columns.Count &gt; 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 &gt; 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 "删除完成用时：" &amp; Format(Timer - tm, "0.00")'耗时
End Sub
</pre></div>
<p class="maodian"><a name="_label3"></a></p><h2>sub4.删除选中单列不含指定字符的行</h2>
<div class="jb51code"><pre class="brush:vb;">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 &gt; 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 &gt; 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
</pre></div>
<p>举例</p>
<p><strong>A列选中运行sub4后得到C列效果</strong></p>
<p style="text-align:center"><img alt="在这里插入图片描述" src="https://img.jbzj.com/file_images/article/202301/2023012910460852.jpg" /></p>
<p class="maodian"><a name="_label4"></a></p><h2>sub5.删除选中列重复的整行</h2>
<p><strong>对于选中多行多列区域，在一行中所有列的内容都重复，则删除该行，仅保留唯一一行，注意区分字母大小写</strong></p>
<div class="jb51code"><pre class="brush:vb;">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 &amp; CStr(Cells(i, j).Value)
      Next
      If Not dict.Exists(res) Then'字典键不存在，新增
            dict(res) = ""
      Else
            Rows(i).Delete'删除行
      End If
    Next
   
End Sub
</pre></div>
<p>举例</p>
<p><strong>多列去重前</strong></p>
<p style="text-align:center"><img alt="在这里插入图片描述" src="https://img.jbzj.com/file_images/article/202301/2023012910460853.jpg" /></p>
<p><strong>选中A-D列，运行sub5，获得结果</strong></p>
<p style="text-align:center"><img alt="在这里插入图片描述" src="https://img.jbzj.com/file_images/article/202301/2023012910460854.jpg" /></p>
頁: [1]
查看完整版本: Excel VBA指定条件删除整行整列的实现