删除范围内的一列会停止循环

时间:2019-05-17 06:49:55

标签: excel vba

我正在尝试删除工作表中所有在其顶行中包含某些文本的列。相同的代码只带有与文本匹配的单元格的Cell.EntireColumn着色即可。

向后进行操作没有帮助。设置一个新范围然后删除整个列确实可以,但是我必须运行几次代码,直到删除所有列。

For Each Cell in newRange
    Cell.EntireColumn.Delete

否则,当我使用Do Loop进行操作时,最后会出现错误。

Dim Cell As Range
Dim Source As Range
Set Source = Range(Cells(1, 1), Cells(1, Columns.Count))
Dim strWords As Variant
strWords = Array("Number", "First Name")

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
        Cell.EntireColumn.Delete
    Next i
Next

End Sub

在第一个循环的这一行,我得到了错误:      “运行时错误'424':       需要对象”

If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then

更新:将值添加到一个范围内可以完美地工作,并且对于较大的文件,速度会明显提高。谢谢大家的贡献!

我需要做的另一件事是

If InStr(UCase(Cell), UCase(strWords(i))) 'is not in string Then
'Add to a union that will later be deleted

我尝试过此操作,但是它将删除所有列,而不是仅删除不包含字符串之一的那些列。

If InStr(UCase(Cell), UCase(strWords(i))) = 0

2 个答案:

答案 0 :(得分:2)

您可以通过删除最后的所有内容来运行更有效的过程。试试这个...

Dim Cell As Range
Dim Source As Range
Set Source = Range(Cells(1, 1), Cells(1, Columns.Count))
Dim strWords As Variant
strWords = Array("Number", "First Name")

Dim killRNG As Range
Set killRNG = Cells(1, Columns.Count).EntireColumn

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then
        Set killRNG = union(killRNG, Cell.EntireColumn)
        End If
    Next i
Next


killRNG.Delete (xlLeft)

答案 1 :(得分:1)

在删除For i之后,您需要退出Cell循环,否则i循环仍会尝试访问已删除的单元格。

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            Cell.EntireColumn.Delete
            Exit For
        End If
    Next i
Next Cell

甚至更好地(使用Union()收集所有单元格并最后删除它们(快得多)

Dim ColsToDelete As Range

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            If ColsToDelete Is Nothing Then
                Set ColsToDelete = Cell.EntireColumn
            Else
                Set ColsToDelete = Union(ColsToDelete, Cell.EntireColumn)
            End If
            Exit For
        End If
    Next i
Next Cell

'delete all collected colmuns in the end at once
If Not ColsToDelete Is Nothing Then ColsToDelete.Delete

请注意,当您使用union()时,您不必一定要向后循环Step -1,因此向前循环也将起作用,因为您会在最后一次循环时删除所有行数字不再改变。

还要收集您不删除的列(请参阅下面的注释和已编辑的问题)。

Dim ColsToDelete As Range
Dim ColsToKeep As Range, IsDeleted As Boolean

For Each Cell In Source
    IsDeleted = False 'initialize
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            IsDeleted = True
            If ColsToDelete Is Nothing Then
                Set ColsToDelete = Cell.EntireColumn
            Else
                Set ColsToDelete = Union(ColsToDelete, Cell.EntireColumn)
            End If
            Exit For
        End If
    Next i
    If Not IsDeleted Then
        If ColsToKeep Is Nothing Then
            Set ColsToKeep = Cell.EntireColumn
        Else
            Set ColsToKeep = Union(ColsToKeep, Cell.EntireColumn)
        End If   
    End If 
Next Cell

'delete all collected rows in the end at once
If Not ColsToDelete Is Nothing Then ColsToDelete.Delete

请注意,我将变量名RowsToDelete更改为ColsToDelete,因为它的命名错误。