For循环在excel VBA中没有完全循环

Bev*_*oMG 2 excel vba

我有一个宏,我在其中搜索一行中的文本,如果一列没有我指定的文本,则将其删除。这是我的代码:

Private Sub Test()

Dim lColumn As Long
    lColumn = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column


Dim i As Long
Dim myCell As Range
Dim myRange As Range
Set myRange = Worksheets("2019").Range(Cells(2, 1), Cells(2, lColumn))

For Each myCell In myRange
  If Not myCell Like "*($'000s)*" And Not myCell Like "*Stmt Entry*" And Not myCell Like "*TCF*" And_ 
  Not myCell Like "*Subtotal*" And Not myCell Like "*Hold*" Then
    myCell.EntireColumn.Select
    Selection.Delete
  End If

Next

End Sub
Run Code Online (Sandbox Code Playgroud)

我的问题是,当我执行宏时,它只会删除一些列,而不是范围末尾的列。如果我然后再次运行宏,它将成功删除我要求它删除的所有列。

如果我将宏切换到 - 比方说 - 使单元格加粗而不是删除它们,它每次都能完美运行。

我错过了什么?

非常感谢!

Mat*_*don 9

尽管每个人都在这个和链接的帖子中说“只是向后循环”,但这不是您想要做的。

它会起作用,然后你的下一个问题将是“我怎样才能加速这个循环”。

真正的解决方案是停止你正在做的事情,并以不同的方式做事。在迭代时修改集合从来都不是一个好主意。

从一个可以将两个范围合并为一个的辅助函数开始:

Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
    If source Is Nothing Then
        'note: returns Nothing if toCombine is Nothing
        Set CombineRanges = toCombine
    Else
        Set CombineRanges = Union(source, toCombine)
    End If
End Function
Run Code Online (Sandbox Code Playgroud)

然后声明一个toDelete范围并使用此CombineRanges函数在您迭代时构建(“选择”)Range- 请注意,此循环不会修改任何地方的任何单元格:

Dim sheet As Worksheet
' todo: use sheet's codename instead if '2019' is in ThisWorkbook
Set sheet = ActiveWorkbook.Worksheets("2019")

Dim source As Range
' note: qualified .Cells member calls refer to same sheet as .Range call
Set source = sheet.Range(sheet.Cells(2, 1), sheet.Cells(2, lColumn))

Dim toDelete As Range
Dim cell As Range
For Each cell In source
    'note: needed because comparing cell.Value with anything will throw error 13 "type mismatch" if cell contains a worksheet error value.
    'alternatively, use cell.Text.
    If Not IsError(cell.Value) Then
        If Not cell.Value Like "*($'000s)*" _
            And Not cell.Value Like "*Stmt Entry*" _
            And Not cell.Value Like "*TCF*" _
            And Not cell.Value Like "*Subtotal*" _
            And Not cell.Value Like "*Hold*" _
        Then
            Set toDelete = CombineRanges(cell, toDelete)
        End If
    End If
Next
Run Code Online (Sandbox Code Playgroud)

最后,最后一步是删除.EntireColumn了的toDelete范围......如果不是Nothing在这一点上:

If Not toDelete Is Nothing Then toDelete.EntireColumn.Delete
Run Code Online (Sandbox Code Playgroud)