![](/img/trans.png)
[英]Excel- Delete rows if a cell in a particular column contains values found in another column
[英]How to delete rows from excel files if a cell in a particular column contains the string of array?
我在許多文件夾中都有許多Excel文件,我需要從所有文件中的ex列中刪除行。 B是數組中的單詞:
對於前。 我的壞話清單:
太陽,樹木,大汽車,杯子,...
如果A2列為“太陽是太陽系中心的星星”。 -此行已被刪除。
如果in列中為“ thesunis the ..”-該行已被刪除。 但是不好!
我的問題是:
這是我的代碼:
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
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
考慮使用帶通配符%
的LIKE運算符查詢字符串搜索的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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.