Excel删除列中包含特定单词的行

时间:2015-06-12 15:59:30

标签: excel vba excel-vba

我是excel脚本/宏观的新手

我有一张大量的Excel表格,我需要从中删除一些行。

任何包含以下单词的行:cat,dog,horse,fish

尝试过这样的事情(以及其他一些尝试)。

Sub DeleteRows() 
    Dim c As Range 
    Dim SrchRng 

    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp)) 
    Do 
        Set c = SrchRng.Find("dog","cat","horse","fish", LookIn:=xlValues) 
        If Not c Is Nothing Then c.EntireRow.Delete 
    Loop While Not c Is Nothing 
End Sub 

一些细节(因为我不确定真正需要什么信息)。

这些词总是在第二栏(但它可能是“乔治鱼”之类的东西,它需要删除那一行。

任何帮助都会很棒,谢谢!

2 个答案:

答案 0 :(得分:0)

我在没有宏或脚本的帮助下完成了这项工作。

在“数据”选项卡中选择过滤器,然后选择按字词过滤。

输入单词,然后只删除出现的所有行。

将来任何人都会回答这个问题!

答案 1 :(得分:0)

这很有效。

Sub DeleteRows()

Dim ws As Worksheet
Dim lastRow As Long
Dim lookAt As Range, thisCell As Range, nextCell As Range
Dim keyWord(0 To 3) As String, targetColumn As String
Dim i As Integer

keyWord(0) = "cat"
keyWord(1) = "dog"
keyWord(2) = "horse"
keyWord(3) = "fish"

On Error GoTo Err

Set ws = Application.ActiveSheet

'get last populated row number
With ws
    If WorksheetFunction.CountA(Cells) > 0 Then
        lastRow = Cells.Find(what:="*", SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious).Row
    End If
End With

'define the target column
targetColumn = "A"
Set lookAt = ActiveSheet.Range(targetColumn & "1:" & targetColumn & lastRow)

'for each item in keyWord array
For i = LBound(keyWord) To UBound(keyWord)
    'look for that word throughout range
    Set thisCell = lookAt.Find(what:=keyWord(i), LookIn:=xlValues, lookAt:=xlPart, SearchDirection:=xlNext)
        If Not thisCell Is Nothing Then
            Set nextCell = thisCell
            Do
                Set thisCell = lookAt.FindNext(After:=thisCell)
                If Not thisCell Is Nothing Then
                    If InStr(1, thisCell.Text, keyWord(i)) Then
                        thisCell.ClearContents
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If
Next i

' delete empty rows
On Error Resume Next
    Range(targetColumn & "1:" & targetColumn & lastRow).Select
    Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete

Err:
    Exit Sub

End Sub