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

这将收集RangeB 中所有非空的单元格 (<> "") 并在循环后一次性删除行。

检查 not empty (<> "") 或Len() > 0IMO 比 using 更好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 回答