删除目录下所有工作簿工作表不包含关键字的行，有代码但未实现，请高手帮忙

kjfhsklfsjflksj · 发表于 2020-1-7 17:12

已经有一段VBA代码判断excel中是否有包含 szmg的关键字，只要包括就不删除，不包括szmg字段的则删除，
代码见附件中《VBA代码放这里.xlsm》。

Sub 批量删除工作表()

Application.ScreenUpdating = False '关闭屏幕刷新

Dim wb As Workbook '定义工作簿对象

Set Fso = CreateObject("Scripting.FileSystemObject") '引用fso对象
For Each oFile In Fso.GetFolder(ThisWorkbook.Path & "\111\").Files '遍历当前工作簿路径下的“数据源”文件夹内所有文件
If oFile.Name Like "*.xls*" Then '如果拓展名包含xls

      Set wb = Workbooks.Open(oFile)
      Application.DisplayAlerts = False '关闭警告信息

         For Each sh In wb.Worksheets
               arr = sh.[a1].CurrentRegion
                           For i = UBound(arr) To 2 Step -1
                              For j = 2 To UBound(arr, 2)
                                    If arr(i, j) Like "*szmg*" Then n = 1: Exit For
                              Next j
'                               If n = 0 Then Rows(i).interior.Color=RGB(221,221,221)

                              If n = 0 Then Rows(i).Delete
                              n = 0
                           Next i
            Next sh
   wb.Close True

      Application.DisplayAlerts = True '恢复警告信息
      Set wba = Nothing
End If
Next oFile

Set Fso = Nothing

Application.ScreenUpdating = True '恢复屏幕刷新

MsgBox ("完成。")

End Sub

执行以后存在2大问题：
1、无法对整个文件夹中的所有xlsx文件执行，比如“二级目录”文件夹的4.xlsx 无法执行到。
2、一个工作簿中有多个工作表，只执行到了其中一个。比如1.xlsx中 1111工作表、2222工作表，其中一个无法执行到。

我的代码按道理包括了实现以上两个要求的语句，但均未成功，请高手帮忙看看代码哪里错了？

样本.zip (73.2 KB, 下载次数: 4)

y1983y · 发表于 2020-1-8 13:03

看看是不是你想要的结果

kjfhsklfsjflksj · 发表于 2020-2-20 10:19

y1983y 发表于 2020-1-8 13:03
看看是不是你想要的结果

AK.Sheets(i).Cells(j, jCol + 1) = AK.Sheets(i).Cells(i, jCol + 1) + 1
谢谢你，想问一下这一句话怎么理解，想不通。。。

y1983y · 发表于 2020-2-21 07:45

kjfhsklfsjflksj 发表于 2020-2-20 10:19
AK.Sheets(i).Cells(j, jCol + 1) = AK.Sheets(i).Cells(i, jCol + 1) + 1
谢谢你，想问一下这一句话怎 ...

也就是增加一个辅助列，如果改行包含szmg字符，则在最后一列单元格里赋值为1
再根据最后一列的情况来进行删行

kjfhsklfsjflksj · 发表于 2020-2-21 15:40

y1983y 发表于 2020-2-21 07:45
也就是增加一个辅助列，如果改行包含szmg字符，则在最后一列单元格里赋值为1
再根据最后一列的情况来进 ...

好的，我已经理解了。我自己添加了一个打印输出，也就是每个表找到了多少个包含关键字的情况。

新的问题2个：
1、我可能不止一个关键字 szmg，
可能还有 ceshi、 nihao等关键字也要加入识别的范围，
该如何改一下？用ifelse迭代吗？

2、目前程序对数据量不多的EXCEL可以顺利执行，
但是个别EXCEL本身数据量多，可能含有5000多行。
一运行本VBA就程序无响应了，如何解决，有优化的方法吗？

以下是我最新改后的VBA，请帮忙看看。

样本0221.zip (79.18 KB, 下载次数: 0)

		自动登录	找回密码
密码			免费注册

[求助] 删除目录下所有工作簿工作表不包含关键字的行，有代码但未实现，请高手帮忙

最新热点 /1