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 のカーソルと 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

多くの行と多くの条件で作業している場合は、この行削除方法を使用することをお勧めします

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 に答える
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 に答える