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

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

我试过另一种技术： set rng = union(rng,c.EntireRow) ，然后删除整个范围，但是我不能防止错误信息。

我也尝试过将每行添加到select中，并且在select了所有内容之后（如在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

你不需要一个循环来做到这一点。 自动filter效率更高。 （类似于游标与SQL中的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

你有没有尝试使用“ @ ”作为标准，然后使用简单的自动filter

 specialcells(xlcelltypevisible).entirerow.delete 

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

Answer 3

使用用户shahkalpesh提供的示例，我成功创build了以下macros。 我仍然对学习其他技术感到好奇（比如Fnostro在其中清除内容，sorting，然后删除）。 我是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

而不是循环和引用每个单元格1，抓住一切，把它放入一个变种数组; 然后循环变体数组。

起动机：

 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