Question

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

我尝试了另外一种技术：set rng = union(rng,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

Answer 1

您不需要循环来执行此操作。自动过滤器效率更高。（类似于SQL中的cursor 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

备注：

.Offset(1,0)阻止我们删除标题行

.SpecialCells(xlCellTypeVisible)指定自动过滤后应用的行

.EntireRow.Delete删除除标题行
之外的所有可见行

逐步执行代码，您可以看到每行的功能。在VBA编辑器中使用F8。

Answer 2

您是否尝试过使用“ @ ”作为标准的简单自动过滤器，然后使用

specialcells(xlcelltypevisible).entirerow.delete

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

Answer 3

使用用户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

Answer 4

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

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

Answer 5

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

简化版：

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

如果单元格不包含'@'，则删除整行的有效方法

5 个答案: