Question

我知道，这个问题已被问过几千次了。但每当我拿起解决方案时，我调试时出现错误。（错误1004）

我使用的数据库大约有300000行，超过一半的人不关心。（我知道有过滤器，但想要擦除以减少文件并加快处理速度。）

然后，如果列M具有像“water”，“beer”或“vodka”这样的关键字，它将删除该行。我的意思是，不需要是确切的单词，只需要关键字。

OBS：第1行是带有冻结线的表格标题。

谢谢！

Answer 1

将来，请发布您先尝试过的社区代码，以帮助您解决问题。话虽如此，试试这个：

Sub Test()
    Dim x as Long
    Dim i as Long

    x = Sheets("SOVI").Range("M" & Rows.Count).End(xlUp).Row

    For i = x to 2 Step -1 
        If InStr(1, Range("M" & i).Value, "water", vbTextCompare) Or InStr(1, Range("M" & i).Value, "beer", vbTextCompare) Or InStr(1, Range("M" & i).Value, "vodka", vbTextCompare) Then
            Range("M" & i).entirerow.delete
        End If
    Next i
End Sub

Answer 2

我会使用略有不同的方法，使用Like和Select Case - 如果您想将其扩展为更多类型的饮品，这将在未来为您提供更多功能。

Sub FindDrink()

Dim lRow As Long
Dim i As Long
Dim sht As Worksheet

' always set your sht, modify to your sheet name
Set sht = ThisWorkbook.Sheets("Sheet1")
lRow = sht.Cells(sht.Rows.Count, "M").End(xlUp).Row

For i = lRow To 2 Step -1
    Select Case True
        Case (sht.Cells(i, "M").Value Like "*beer*") Or (sht.Cells(i, "M").Value Like "*water*") Or (sht.Cells(i, "M").Value Like "*vodka*")
            Range("M" & i).EntireRow.Delete

        Case Else
            ' if you decide to do other things in the future for other values

    End Select

Next i

End Sub

Answer 3

以下代码在我的机器上处理样本数据的时间不到4秒：

using System.Reflection;

Answer 4

使用内置过滤功能的excel实现最高速度

<强> Autofilter

Option Explicit

Sub main()
    Dim keysToErase As Variant, key As Variant

    keysToErase = Array("water", "beer", "vodka") '<--| list your keywords to delete matching column "M" rows with

    Application.DisplayAlerts = False '<--| prevent alerts dialog box from appearing at every rows deletion
    With Workbooks("test").Worksheets("SOVI").Range("A1").CurrentRegion '<--| this gets the range of all contiguous cells to "A1"
        For Each key In keysToErase '<--| loop through keys
            .AutoFilter field:=13, Criteria1:="*" & key & "*" '<--| filter column "M" with key
            If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete '<--| delete filtered cells, if any
        Next key
        .Parent.ShowAllData '<--| .. show all rows back...
    End With
    Application.DisplayAlerts = True '<--| allow alerts dialog box back
End Sub

<强> AdvancedFilter

Option Explicit

Sub main2()
    Application.DisplayAlerts = False '<--| prevent alerts dialog box from appearing at every rows deletion
    With Workbooks("test").Worksheets("SOVI").Range("A1").CurrentRegion '<--| this gets the range of all contiguous cells to "A1"
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Parent.Range("U1:U4") '<--| this filters on all keys you placed in cells "U2:U4" with cell "U1" with wanted data header
        If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete '<--| delete filtered cells, if any
        .Parent.ShowAllData '<--| .. show all rows back...
    End With
    Application.DisplayAlerts = True '<--| allow alerts dialog box back
End Sub

Answer 5

尝试使用以下代码

Sub test()
    Application.DisplayAlerts = False
    Dim lastrow As Long
    Dim i As Long
    Dim currentrng As Range
    lastrow = Range("M" & Rows.Count).End(xlUp).Row
    For i = lastrow To 2 Step -1
        Set currentrng = Range("M" & i)
        If ((currentrng Like "*water*") Or (currentrng Like "*beer*") Or (currentrng Like "*vodka*")) Then
            currentrng.EntireRow.Delete shift:=xlUp
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

如果列包含文本，请删除行

5 个答案: