ExceVBA删除指定字符所在的行_优化版

哆哆Excel

发布于 2023-09-09 02:48:53

46300

代码可运行

文章被收录于专栏：哆哆Excel哆哆Excel

运行总次数：0

代码可运行

ExceVBA删除指定字符所在的行_优化版

=====start====

1.ExcelVBA删除包含指定字符所在的行

2.在Excel中通过VBA对Word文档进行查找替换

3.ExcelVBA文件操作-获取文件夹（含子文件夹）所有文件列表（优化版）

=====end====

【问题】

在实际工作中，要删除含有某字符的所在的行，如果数据不多，手工可以完成，如果数据量多，用前面的的文章：ExcelVBA删除包含指定字符所在的行用Find、FindNext,再删除，新的问题:如果sheet多，每个表是上w的数据，跑起来也很卡。

【思路】

所以用了把用Exce的替换方法，批量替换“字符”为"#DIV/0!"，再用.SpecialCells(xlCellTypeConstants, 16)的方法快速定位。再delete,速度快了，效率高了

【代码】

Sub yhd_ExceVBA删除指定字符所在的行_优化版()
    Dim dic As Object, dicRng As Range
    Dim Rngs As Range, rn As Range
    Set dic = CreateObject("scripting.dictionary")
    With Worksheets("Sheet1 (2)")
        .Cells.Replace What:="缺考", Replacement:="#DIV/0!", LookAt:=xlPart, SearchOrder _
                :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Set Rngs = .UsedRange.SpecialCells(xlCellTypeConstants, 16)
'        Rngs.EntireRow.Delete
'当数据有两个在同一行时以上代码出错，于是用了下面的代码
        For Each rn In Rngs
            dic(rn.Row) = ""
        Next
        Debug.Print Rngs.Count, dic.Count
        Set dicRng = .Rows(dic.keys()(0))
        For i = 1 To dic.Count - 1
            Set dicRng = Union(dicRng, .Rows(dic.keys()(i)))
        Next
        dicRng.Delete
    End With
End Sub

Sub 构结数据用的()
    For Each sht In Worksheets
        With sht
            For i = 1 To 10
                r = Excel.Application.WorksheetFunction.RandBetween(2, 184)
                c = Excel.Application.WorksheetFunction.RandBetween(3, 11)
                .Cells(r, c) = "缺考"
            Next i
            j = j + 1
            .Name = "Sheet" & j
        End With
    Next
End Sub