0

私はExcelでデータのブロックを見るように設計されたこの単純なループを持っています:それは最初にそれが下に伸びる行数を識別します-これは各行Nで反復回数を定義し、セル(N,B)が空 - その場合、その行を削除します。

これはうまくいかないようです。また、何年もかかります！これを非常に迅速に行うものが必要です。

どんな考えでも評価されます

Sub PREBILLvariant2()

        Dim N As Long

 For N = 1 To Worksheets("EMEA input").Cells(Rows.Count, "A").End(xlUp).Row

If InStr(Cells(N, "B").Value, "") > 0 Then Worksheets("EMEA input").Cells(N, "B").EntireRow.Delete


    Next N

    End Sub
4

3 に答える 3

3

別の方法を次に示します。私は常に、フィルタリングがこれらのことを行うための最速の方法であることを発見しました.

Public Sub filterThenDelete()
    Application.ScreenUpdating = False

    Dim r As Excel.Range
    Set r = Sheets("EMEA input").UsedRange

    r.AutoFilter Field:=2, Criteria1:=""

    Dim deleteRange As Excel.Range
    Set deleteRange = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.Columns.Count).Cells.SpecialCells(xlCellTypeVisible)

    deleteRange.EntireRow.Delete

    Sheets("EMEA input").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

参考までに、AutoFilter についてField:=2は、「Criteria1 で見つかったフィルターを、選択した範囲の列 2 に適用する」と言っています。または単に「空白の値で列 B をフィルター処理する」。

于 2013-07-26T18:03:40.517 に答える
2

このようなもの：

Sub PREBILLvariant3()
    Dim ws As Worksheet
    Dim lRows As Long, N As Long
    Dim rngToDelete As Range

    Application.ScreenUpdating = False
    Set ws = Worksheets("EMEA input")
    lRows = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For N = 1 To lRows
        If ws.Cells(N, "B").Value <> "" Then
            If rngToDelete Is Nothing Then
                Set rngToDelete = ws.Cells(N, "B")
            Else
                Set rngToDelete = Union(rngToDelete, ws.Cells(N, "B"))
            End If
        End If
    Next N
    rngToDelete.EntireRow.Delete
    Application.ScreenUpdating = True
    Set ws = Nothing
End Sub

これは、空ではない B のすべてのセル (<> "") として収集しRange、ループの後に一度に行を削除します。

特定のテキストを探しているわけではないため、空でないこと (<> "") をチェックするか、またはLen() > 0を使用するよりも IMO の方が適しています。InStr()

于 2013-07-26T17:26:12.720 に答える
-2

これはより標準的なアプローチです。

列 A にコンテンツがあるすべての行をループし、列 C に空のセルがあるすべての行を削除します

Sub subDeleteRows()
    Dim lngRow As Long: lngRow = 1

    subSpeedUp True

    Do Until IsEmpty(Sheets("EMEA input").Cells(lngRow, 1))
        If IsEmpty(Sheets("EMEA input").Cells(lngRow, 2)) Then
            Sheets("EMEA input").Cells(lngRow, 2).EntireRow.Delete
        Else
            lngRow = lngRow + 1
        End If
    Loop

    subSpeedUp False
End Sub

Sub subSpeedUp(startStop As Boolean)
    If startStop Then
        Application.ScreenUpdating = False
        Application.DisplayStatusBar = False
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        ActiveSheet.DisplayPageBreaks = False
    Else
        Application.ScreenUpdating = True
        Application.DisplayStatusBar = True
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
    End If
End Sub

時間があれば、次の記事をお読みください: http://msdn.microsoft.com/en-us/library/office/ff726673.aspx

于 2013-07-26T17:56:25.580 に答える