如果特定列中的单元格包含数组字符串，如何从Excel文件中删除行？

Question

I have many excel files in many folders and I need to delete the rows from all files where in column for ex. B are words from array:

For ex. my bad words list:

the sun, tree, big car, cup, ....

If A2 column is 'The Sun is the star at the center of the Solar System.' - this row has been deleted.

If in column is 'thesunis the..' - this row has been deleted. But is bad!

And my questions:

1. How to delete rows with exact words of array element?
2. How to count array elements?
3. How to escape single quote in array element (example in code below)
4. How to open all files from folder "C://folder" and after run code save all?

Here is my code:

Sub code()
    Dim MyValue As String
    Dim a As Integer
    '------------------------------------------------------
    ArrayValueToRemove = Array("the sun", "code 'in", "another")
    Range("B:B").Select
    '------------------------------------------------------
    For Each cell In Selection
        MyValue = CStr(cell.Value)
        For a = 0 To 2
            If InStr(1, LCase(MyValue), LCase(ArrayValueToRemove(a))) > 0 Then
                cell.EntireRow.Delete
                Exit For
            End If
        Next
    Next cell
End Sub

Answer 1

Sub deleteBadWordRows()
    Dim currentFile, currentSheet, badWords As Variant, lastRow, i As Integer, baseDirectory As String
    '------------------------------------------------------
    baseDirectory = "c:\folder\"
    badWords = Array("the sun", "code 'in", "another")
    '------------------------------------------------------
    currentFile = Dir(baseDirectory)
    While (currentFile <> "")
        Workbooks.Open baseDirectory + currentFile
            For Each currentSheet In Workbooks(currentFile).Worksheets
                lastRow = currentSheet.Cells(currentSheet.Rows.Count, "B").End(xlUp).Row
                For j = 1 To lastRow
                    For i = 0 To UBound(badWords)
                        If InStr(1, LCase(CStr(currentSheet.Cells(j, "B").Value)), LCase(badWords(i))) > 0 Then
                            currentSheet.Rows(j).Delete
                            j = j - 1
                            lastRow = lastRow - 1
                            Exit For
                        End If
                    Next
                Next
            Next
        Workbooks(currentFile).Save
        Workbooks(currentFile).Close
        currentFile = Dir
    Wend
End Sub

Answer 2

Consider an SQL solution to query your string searches using the LIKE operator with wildcard, % . Excel for PC can connect to the Jet/ACE SQL Engine (Window .dll files) and query workbooks. Here you avoid the nested looping except for iterating through workbooks.

Below assumes all worksheets are tabular in structure with column headers all beginning at A1. Query results are dumped to a new worksheet where you can delete current worksheet afterwards. Be sure to replace placeholders with actual names, CurrentWorksheet , ColumnA , NewWorksheet :

Sub DeleteSQL()
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer
    Dim wb As Workbook

    Dim dirpath As String: dirpath = "C:\\Folder"
    Dim xlfile As Variant: xlfile = Dir(dirpath & "\*.xls*")

    Do While (xlfile <> "")            
        Set wb = Workbooks.Open(dirpath & "\" & xlfile)
        Set conn = CreateObject("ADODB.Connection")
        Set rst = CreateObject("ADODB.Recordset")

        ' WORKBOOK CONNECTION
        strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                           & "Data Source='" & dirpath & "\" & xlfile & "';" _
                           & "Extended Properties=""Excel 8.0;HDR=YES;"";"            
        ' OPEN DB CONNECTION
        conn.Open strConnection

        ' OPEN RECORDSET
        strSQL = " SELECT * FROM [CurrentWorksheet$]" _
                   & " WHERE [ColumnA] LIKE ""%the sun%"" OR [ColumnA]" _
                   & " LIKE ""%code 'in%"" OR [ColumnA] LIKE ""%another%"""
        rst.Open strSQL, conn

        wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count).Name = "NewWorkSheet" 

        ' RESULTSET COLUMNS
        For i = 1 To rst.Fields.Count
            wb.Worksheets("NewWorkSheet").Cells(1, i) = rst.Fields(i - 1).Name
        Next i      

        ' RESULTSET DATA ROWS
        wb.Worksheets("NewWorkSheet").Range("A2").CopyFromRecordset rst

        wb.Close True
        rst.Close: conn.Close
        Set rst = Nothing: Set conn = Nothing

        xlfile = Dir
    Loop
End Sub