再次请教高手另外一高手的代码错在哪里

远去的部落

代码的目的是同时选中A，B，C，D,E共5列，并将所有同时包含“星”或 ”空“，”老”或“共“,“是”或“月”        “开”或“平“,“口”或“空”的单元格全部删除，每列可以是1048576行，每个单元格内最多有10个汉字或数字或字母，而且代码留有增加同时出现不止10个汉字的余地比如：100个汉字。结果输出保留在原列不要输出到其他列尽可能用高效的代码原因每列有可能是1048576行数据怕用时过长，谢谢！                                               

^星^

请教EXCEL高手另外一位高手写的代码哪里不对了2？.zip (611.39 KB, 下载次数: 6)

2024-3-3 22:57 上传

点击文件名下载附件

liulang0808

楼主的错误代码是从哪里搞的？
是自己写的还是用软件提取的？

liulang0808

Sub DltRow20()
    Dim Arr, x&, i&, R, Brr, K&, Book&, j&
    R = Array("星", "空", "excel") '关键词装入数组r
    Arr = [a1].CurrentRegion
    '数据源装入数组arr。
    ReDim Brr(1 To UBound(Arr), 1 To UBound(Arr, 2))
    For i = 2 To UBound(Arr)
        '遍历数组arr
        Book = 0 '标记值初始化0
        For j = 1 To UBound(Arr, 2)
            For x = 0 To UBound(R)
                '遍历R查看是否包含关键词
                If InStr(1, Arr(i, j), R(x), vbTextCompare) > 0 Then
                    Book = 1: Exit For
                End If
                '是否包含数组r中的关键词，匹配模式不区分字母大小写，如果包含则标记Book=1
                'Exit For查询到结果则退出遍历R，避免无谓循环，提高代码效率
            Next
            If Book = 1 Then Exit For
        Next j
        If Book = 0 Then
            '如果没有包含关键词，则Book为0，保留该行数据，装入结果数组brr
            K = K + 1 '累加行数
            For j = 1 To UBound(Arr, 2)
                '遍历arr该行数据装入brr
                Brr(K, j) = Arr(i, j)
            Next
        End If
    Next
    [a1].CurrentRegion.ClearContents
    '清除原数据
    If K > 0 Then [a1].Resize(K, UBound(Brr, 2)) = Brr
    '将结果数组放回单元格区域
    MsgBox "处理完成。"
End Sub

liulang0808

请教EXCEL高手另外一位高手写的代码哪里不对了1112？.zip (588.6 KB, 下载次数: 6)

2024-3-4 08:23 上传

点击文件名下载附件

附件代码按照楼主的描述，和源代码的思路做了调整供参考

远去的部落

^星^ 发表于 2024-3-3 22:57

谢谢星的再次帮助，您的代码可以运行但运行超过每列20万行后用时过长可能需要升级我电脑配置才能运行快些

远去的部落

liulang0808 发表于 2024-3-4 08:16
楼主的错误代码是从哪里搞的？
是自己写的还是用软件提取的？

百度文库上下载的，多谢您的代码