vba 如果单元格不包含“@”，则删除整行的有效方法
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16901436/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Efficient way to delete entire row if cell doesn't contain '@'
提问by Parseltongue
I'm creating a fast sub to do a validity check for emails. I want to delete entire rows of contact data that do not contain a '@' in the 'E' Column. I used the below macro, but it operates too slowly because Excel moves all the rows after deleting.
我正在创建一个快速子程序来检查电子邮件的有效性。我想删除“E”列中不包含“@”的整行联系人数据。我使用了下面的宏，但它运行速度太慢，因为 Excel 在删除后移动了所有行。
I've tried another technique like this: set rng = union(rng,c.EntireRow), and afterwards deleting the entire range, but I couldn't prevent error messages.
我尝试了另一种类似这样的技术：set rng = union(rng,c.EntireRow)，然后删除整个范围，但我无法阻止错误消息。
I've also experimented with just adding each row to a selection, and after everything was selected (as in ctrl+select), subsequently deleting it, but I could not find the appropriate syntax for that.
我还尝试将每一行添加到一个选择中，然后在选择所有内容后（如 ctrl+select 中），随后将其删除，但我找不到合适的语法。
Any ideas?
有任何想法吗？
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
回答by Jon Crowell
You don't need a loop to do this. An autofilter is much more efficient. (similar to cursor vs. where clause in SQL)
您不需要循环来执行此操作。自动过滤器效率更高。（类似于 SQL 中的游标 vs. where 子句）
Autofilter all rows that don't contain "@" and then delete them like this:
自动过滤所有不包含“@”的行，然后像这样删除它们：
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
NOTES:
笔记：
.Offset(1,0)prevents us from deleting the title row.SpecialCells(xlCellTypeVisible)specifies the rows that remain after the autofilter has been applied.EntireRow.Deletedeletes all visible rows except for the title row
.Offset(1,0)阻止我们删除标题行.SpecialCells(xlCellTypeVisible)指定应用自动过滤器后剩余的行.EntireRow.Delete删除除标题行之外的所有可见行
Step through the code and you can see what each line does. Use F8 in the VBA Editor.
逐步执行代码，您可以看到每一行的作用。在 VBA 编辑器中使用 F8。
回答by JosieP
Have you tried a simple auto filter using "@" as the criteria then use
您是否尝试过使用“ @”作为标准的简单自动过滤器然后使用
specialcells(xlcelltypevisible).entirerow.delete
note: there are asterisks before and after the @ but I don't know how to stop them being parsed out!
注意：@ 前后都有星号，但我不知道如何阻止它们被解析！
回答by Parseltongue
Using an example provided by user shahkalpesh, I created the following macro successfully. I'm still curious to learn other techniques (like the one referenced by Fnostro in which you clear content, sort, and then delete). I'm new to VBA so any examples would be very helpful.
使用用户 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
回答by Parseltongue
When you are working with many rows and many conditions, you better off using this method of row deletion
当您处理许多行和许多条件时，最好使用这种行删除方法
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
回答by Profex
Instead of looping and referencing each cell 1 by 1, grab everything and put it into a variant array; Then loop the variant array.
不是逐一循环和引用每个单元格，而是抓取所有内容并将其放入变体数组中；然后循环变量数组。
Starter:
起动机：
Sub Sample()
' Look in Column D, starting at row 2
DeleteRowsWithValue "@", 4, 2
End Sub
The Real worker:
真正的工人：
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
