|
本帖最后由 水果糖22 于 2023-6-16 14:16 编辑
在一个文件夹下有多个文件,因为是不同客户发来的表,所以格式内容不统一,关键字在一行中的位置不固定,现在需要保留含有关键字的行,有多个关键字,其他行删除,写了一段代码,运行后除了表头所有行全被删除了,请各位老师看下是什么问题呢?
Sub DeleteRowsWithoutKeywords()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim keyword1 As String
Dim keyword2 As String
Dim keyword3 As String
' 设置文件夹路径
folderPath = "C:\Users\Administrator\Desktop\数据\"
keyword1 = "物料"
keyword2 = "钢材"
keyword3 = "铁"
' 获取文件夹中的所有文件
fileName = Dir(folderPath & "*.xls*")
' 遍历文件夹中的所有文件
Do While fileName <> ""
' 打开文件
Set wb = Workbooks.Open(folderPath & fileName)
' 遍历文件中的所有工作表
For Each ws In wb.Worksheets
' 获取工作表最后一行和最后一列
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' 从最后一行开始遍历每一行
For i = lastRow To 2 Step -1
Dim containsKeywords As Boolean
containsKeywords = True
' 遍历当前行的所有列
For j = 1 To lastCol
' 判断当前列是否包含关键字
If Not (ws.Cells(i, j).Value Like keyword1) Or Not (ws.Cells(i, j).Value Like keyword2) Or Not (ws.Cells(i, j).Value Like keyword3)Then
' 当前列不包含关键字,将标志设置为False
containsKeywords = False
Exit For
End If
Next j
' 如果标志为False,则删除该行
If Not containsKeywords Then
ws.Rows(i).EntireRow.Delete
End If
Next i
Next ws
' 保存并关闭文件
wb.Close
SaveChanges = True
' 继续处理下一个文件
fileName = Dir
Loop
End Sub
|
|