我正在尝试检查Q列中单元格的内容,并删除该列中包含0的行。
宏应该在单元格Q11的Q列开始检查,并在遇到包含文本“END”的单元格时停止。完成后,它应该选择电子表格左上角的单元格,通常是A1,但我有一个合并的单元格,所以它是A1:K2。
以下是我最近两个版本的宏:
'My second to last attempt
Sub DeleteRowMacro1()
Dim i As Integer
i = 11
Do
Cells(i, 17).Activate
If ActiveCell.Value = 0 Then
ActiveCell.EntireRow.Delete
End If
i = i + 1
Loop Until ActiveCell.Value = "END"
Range("A1:K2").Select
End Sub
'My last attempt
Sub DeleteRowMacro2()
Dim i As Integer
i = 11
GoTo Filter
Filter:
Cells(i, 17).Activate
If ActiveCell.Value = "END" Then GoTo EndingCondition
If ActiveCell.Value = "" Then GoTo KeepCondition
If ActiveCell.Value = 0 Then GoTo DeleteCondition
If ActiveCell.Value > 0 Then GoTo KeepCondition
EndingCondition:
Range("A1:K2").Select
KeepCondition:
i = i + 1
GoTo Filter
DeleteCondition:
ActiveCell.EntireRow.Delete
i = i + 1
GoTo Filter
End Sub
DeleteRowMacro1()的作用:
如果在Q列中有文本或大于0的数字,它将离开行,但它会删除具有0 AND空白单元格的单元格的行。我想用空白单元格保留行。
这个宏似乎无法在一次运行中用“END”检查Q11和单元格之间的450个左右的单元格。它每次只删除大约一半的行。前10行左右总是正确完成,但随后它会在Q列中随机选择零或空白的行来删除。
如果我运行宏7或8次,它最终会删除所有带0的行和那些空白的行。我希望它能在一次运行中完成它的工作,而不是删除带有空白单元格的行。
DeleteRowMacro2()的作用:
它永远不会停在“结束”。
我必须运行它7或8次才能完全摆脱列Q中的0的所有行。它似乎也随机检查单元格的删除(并且除了前10个左右之外再次)。
因为它在我运行它时永远不会结束,我的屏幕区域电子表格变成黑色,我只能看到绿色选中的单元格框在Q列的随机位置上下闪烁,直到它到达一个32,000s的行号。之后,我的屏幕返回显示正常的白色电子表格,并出现一个框,显示运行时错误“6”:溢出。
请注意:点击错误框中的“结束”后,我可以看到该宏的工作方式如上所述。
答案 0 :(得分:1)
首先,它是avoid using .Select
/.Activate
的最佳做法。在进行循环/宏时,这可能会导致一些混乱和棘手的写作。
其次,最好避免GoTo
。
此宏将从Q列的最后一行开始,并朝向第11行。如果单元格的值为0
,则它将删除该行。如果值为END
,则会选择您的范围并退出For
循环,然后退出该子目录。
Sub delRows()
Dim lastRow As Long, i As Long
Dim ws as Worksheet
Set ws = Worksheets("Sheet1") ' CHANGE THIS AS NECESSARY
lastRow = ws.Cells(ws.Rows.Count, 17).End(xlUp).Row
For i = lastRow To 11 Step -1
If ws.Cells(i, 17).Value = "END" Then
ws.Range("A1:K2").Select
Exit For
End If
If ws.Cells(i, 17).Value = 0 or ws.Cells(i, 17).Value = "0" Then
ws.Cells(i, 17).EntireRow.Delete
End If
Next i
End Sub
答案 1 :(得分:1)
试一试,
Option Explicit
Sub DeleteRowMacro3()
Dim rwend As Variant
With Worksheets("Sheet5")
If .AutoFilterMode Then .AutoFilterMode = False
rwend = Application.Match("end", .Range(.Cells(11, "Q"), .Cells(.Rows.Count, "Q")), 0)
If Not IsError(rwend) Then
With .Range(.Cells(10, "Q"), .Cells(rwend + 10, "Q"))
.AutoFilter Field:=1, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With
End With
End If
.Activate
.Range("A1:K2").Select
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
我不确定你是否专门寻找零或零值,所以我包括空白单元格和数字零。
答案 2 :(得分:0)
尝试使用第一个代码的变体:
Sub DeleteRowMacro1()
Dim i As Integer
i = 11
Do
Cells(i, 17).Activate
If IsEmpty(ActiveCell.Value) Then
ActiveCell.EntireRow.Delete
End If
If ActiveCell.Value = "END" Then
Exit Do
End If
i = i + 1
Loop
Range("A1:K2").Select
End Sub
答案 3 :(得分:0)
尝试这个更简单,更快的版本。它将找到要删除的所有单元格,将它们存储在范围对象中,然后最后一次将它们全部删除。
Public Sub DeleteRowsWithRange()
Dim rngLoop As Range
Dim rngMyRange As Range
For Each rngLoop In Columns("Q").Cells
If rngLoop.Value = "END" Then
Exit For
ElseIf rngLoop.Value = 0 Then
If rngMyRange Is Nothing Then
Set rngMyRange = rngLoop.EntireRow
Else
Set rngMyRange = Union(rngMyRange, rngLoop.EntireRow)
End If
End If
Next rngLoop
If Not rngMyRange Is Nothing Then rngMyRange.Delete xlShiftUp
Range("A1").Activate
Set rngLoop = Nothing
Set rngMyRange = Nothing
End Sub