Vba 在单元格不包含“@”时删除整行的有效方法

我正在创建一个快速子来检查电子邮件的有效性。我想删除在“E”列中不包含“@”的整行联系人数据。我使用了下面的宏，但它运行得太慢，因为Excel在删除后会移动所有行

我尝试过另一种类似的技术：set rng=unionrng，c.EntireRow，然后删除整个范围，但我无法阻止错误消息

我还尝试过将每一行添加到一个选择中，在按ctrl+select选择所有内容之后，随后将其删除，但我找不到合适的语法

有什么想法吗

Sub Deleteit()
    Application.ScreenUpdating = False

    Dim pos As Integer
    Dim c As Range

    For Each c In Range("E:E")

        pos = InStr(c.Value, "@")
        If pos = 0 Then
            c.EntireRow.Delete
        End If
    Next

    Application.ScreenUpdating = True
End Sub

---

这样做不需要循环。自动过滤器的效率要高得多。类似于SQL中的游标vs.where子句

自动筛选所有不包含@的行，然后按如下方式删除它们：

Sub KeepOnlyAtSymbolRows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long

    Set ws = ActiveWorkbook.Sheets("Sheet1")

    lastRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row

    Set rng = ws.Range("E1:E" & lastRow)

    ' filter and delete all but header row
    With rng
        .AutoFilter Field:=1, Criteria1:="<>*@*"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    ' turn off the filters
    ws.AutoFilterMode = False
End Sub

注:

.Offset1,0阻止我们删除标题行 .SpecialCellsxlCellTypeVisible指定应用自动筛选后保留的行 .EntireRow.Delete删除除标题行以外的所有可见行

---

逐步浏览代码，您可以看到每一行的作用。在VBA编辑器中使用F8。

使用用户shahkalpesh提供的示例，我成功创建了以下宏。我仍然很想学习其他技术，比如Fnostro引用的技术，在该技术中，您可以清除内容、排序，然后删除。我是VBA新手，所以任何例子都会非常有用

   Sub Delete_It()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    With ActiveSheet
        .Select
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False

        'Firstrow = .UsedRange.Cells(1).Row
        Firstrow = 2
        Lastrow = .Cells(.Rows.Count, "E").End(xlUp).Row

        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "E")
                If Not IsError(.Value) Then
                    If InStr(.Value, "@") = 0 Then .EntireRow.Delete
                End If
            End With
         Next Lrow
        End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

---

您是否尝试过使用@作为标准的简单自动筛选，然后使用

specialcells(xlcelltypevisible).entirerow.delete

---

注意：@前后都有星号，但我不知道如何阻止它们被解析出来

处理多行和多个条件时，最好使用这种行删除方法

Option Explicit

Sub DeleteEmptyRows()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim i&, lr&, rowsToDelete$, lookFor$

    '*!!!* set the condition for row deletion
    lookFor = "@"

    Set ws = ThisWorkbook.Sheets("Sheet1")
    lr = ws.Range("E" & Rows.Count).End(xlUp).Row

    ReDim arr(0)

    For i = 1 To lr
     If StrComp(CStr(ws.Range("E" & i).Text), lookFor, vbTextCompare) = 0 then
       ' nothing
     Else
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr) - 1) = i
     End If
    Next i

    If UBound(arr) > 0 Then
        ReDim Preserve arr(UBound(arr) - 1)
        For i = LBound(arr) To UBound(arr)
            rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
        Next i

        ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
    Else
        Application.ScreenUpdating = True
        MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
        Exit Sub
    End If

    If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
    Set ws = Nothing
End Sub

---

不要逐个循环和引用每个单元格，而是抓住所有内容并将其放入一个变量数组中；然后循环变量数组

起动器：

Sub Sample()
    ' Look in Column D, starting at row 2
    DeleteRowsWithValue "@", 4, 2
End Sub

真正的工人：

Sub DeleteRowsWithValue(Value As String, Column As Long, StartingRow As Long, Optional Sheet)
Dim i As Long, LastRow As Long
Dim vData() As Variant
Dim DeleteAddress As String

    ' Sheet is a Variant, so we test if it was passed or not.
    If IsMissing(Sheet) Then Set Sheet = ActiveSheet
    ' Get the last row
    LastRow = Sheet.Cells(Sheet.Rows.Count, Column).End(xlUp).Row
    ' Make sure that there is work to be done
    If LastRow < StartingRow Then Exit Sub

    ' The Key to speeding up the function is only reading the cells once 
    ' and dumping the values to a variant array, vData
    vData = Sheet.Cells(StartingRow, Column) _
                 .Resize(LastRow - StartingRow + 1, 1).Value
    ' vData will look like vData(1 to nRows, 1 to 1)
    For i = LBound(vData) To UBound(vData)
        ' Find the value inside of the cell
        If InStr(vData(i, 1), Value) > 0 Then
            ' Adding the StartingRow so that everything lines up properly
            DeleteAddress = DeleteAddress & ",A" & (StartingRow + i - 1)
        End If
    Next
    If DeleteAddress <> vbNullString Then
        ' remove the first ","
        DeleteAddress = Mid(DeleteAddress, 2)
        ' Delete all the Rows
        Sheet.Range(DeleteAddress).EntireRow.Delete
    End If
End Sub

---

首先，限制要遍历的单元格数量。i、 e.不要使用范围e:e，在itI中使用包含数据的范围我一直想知道如何做到这一点-如何选择包含第一个单元格直到包含数据的最后一个单元格的范围？-看看这个。我相信，它会为你解答的。注册您的问题，假设您位于包含数据的单元格A1上，现在按ctrl+向下箭头键。这将选择从A1开始的所有单元直到包含数据的最后一个单元格注释：中间不应该有空白单元格。使用VBA，您可以lastCell=RangeA1.EndXLDown也-不删除。清除行，然后在end@Fnostro-有关于如何做的参考吗？我得到一个“下标超出范围”错误。你能解释两件事吗？'设置rng=ws.RangeA1:A和lastRow的作用是什么？为什么是A1:A？那么.Offset1，0.SpecialCellsxlCellTypeVisible.EntireRow.Delete做什么呢？我刚刚意识到您正在使用的列是E。错误是因为我搜索了错误的列。将A更改为E，它应该会工作。设置范围指定要自动筛选A1:A的范围，以及最后一行的值。.Offset1,0使我们无法删除标题行。请立即尝试-我编辑了该列。我看到另一个答案将过滤后的答案复制到临时工作表中，然后删除并复制回，但使用更干净！抱歉，我最初发帖时你的答案不在那里。不过，我确实把标准搞砸了！选择会减慢任何代码，应始终避免。我怀疑这是否能达到过滤效率。在让代码正常工作方面做得很好，但在可能的情况下避免范围循环-在较大的数据集上它们可能非常慢。尽可能使用自动筛选、特殊单元或变体阵列。