셀에 '@'가 포함되지 않은 경우 전체 행을 효율적으로 삭제하는 방법

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에 절은 어디에 대 커서) :

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

사용자 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 3

당신은 기준이 다음

specialcells(xlcelltypevisible).entirerow.delete 

메모를 사용할 때 " @"를 사용하여 간단한 자동 필터를 시도 그들을 파싱하지 마라.

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에 의해 각 셀에 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