10

我正在创建一个快速子来对电子邮件进行有效性检查。我想删除“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
4

5 回答 5

24

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

于 2013-06-03T16:44:25.687 回答
3

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

specialcells(xlcelltypevisible).entirerow.delete

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

于 2013-06-03T16:57:04.817 回答
2

使用用户 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
于 2013-06-03T16:55:22.080 回答
2

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

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
于 2013-06-11T14:54:05.597 回答
0

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

起动机：

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
于 2013-12-10T00:06:13.033 回答