对于Loop无法在excel VBA中完全循环
我有一个宏,我在其中搜索行中的文本,如果列中没有我指定的文本,则将其删除.这是我的代码:
I have a macro where I search for text in a row and if a column does not have my specified text it is deleted. Here is my code:
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
我的问题是,当我执行宏时,它只会删除某些列,而不会删除范围末尾的那些列.如果我再次运行宏,它将成功删除我要求它的所有列.
My issue is that when I execute the macro it will only delete some of the columns but not the ones towards the end of the range. If I then run the macro again it will successfully delete all the columns I ask it to.
如果我将宏切换为-假设-使单元格变为粗体而不是删除它们,则每次运行都非常完美.
If I switch the macro to- let's say- make the cells bold instead of deleting them it works perfectly every time.
我想念什么?
非常感谢!
尽管每个人在此&链接的帖子,那不是您想要的.
Despite everyone saying "just loop backwards" in this & linked posts, that's not what you want to do.
它将起作用,然后您的下一个问题是我如何加快循环速度".
It's going to work, and then your next question will be "how can I speed up this loop".
真正的解决方案是停止正在做的事情,并以不同的方式做事.在迭代时修改集合 从来都不是一个好主意.
The real solution is to stop what you're doing, and do things differently. Modifying a collection as you're iterating it is never a good idea.
从一个可以将两个范围合并为一个范围的助手功能开始:
Start with a helper function that can combine two ranges into one:
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
然后声明一个toDelete
范围,并在进行迭代时使用此CombineRanges
函数 build (选择")一个Range
-请注意,此循环不会修改任何单元格任何地方:
Then declare a toDelete
range and use this CombineRanges
function to build ("select") a Range
while you're iterating - note that this loop does not modify any cells anywhere:
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
最后的最后一步是删除toDelete
范围内的.EntireColumn
...如果那时还不是Nothing
:
The last, final step is to delete the .EntireColumn
of the toDelete
range... if it isn't Nothing
at that point:
If Not toDelete Is Nothing Then toDelete.EntireColumn.Delete