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

时间:2016-08-08 22:05:58

标签: excel vba

我在很多文件夹中都有很多excel文件,我需要从列中的所有文件中删除行。 B是数组中的单词:

对于前。我的坏词列表:

太阳,树,大车,杯子,......

如果A2列是'太阳系是太阳系中心的恒星'。 - 此行已被删除。

如果列中的'thesunis是..' - 此行已被删除。但是很糟糕!

我的问题:

  1. 如何删除包含数组元素精确单词的行?
  2. 如何计算数组元素?
  3. 如何在数组元素中转义单引号(以下代码中的示例)
  4. 如何打开文件夹“C://文件夹”中的所有文件,并在运行代码后保存所有文件?
  5. 这是我的代码:

    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
    

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

考虑使用带有通配符%的{​​{3}}运算符查询字符串搜索的SQL解决方案。 Excel for PC可以连接到Jet / ACE SQL引擎(Window .dll文件)和查询工作簿。除了迭代工作簿之外,您可以避免嵌套循环。

下面假设所有工作表都是表格式结构,列标题全部从A1开始。查询结果将转储到新工作表,您可以在其中删除当前工作表。请务必使用实际名称替换占位符, 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