Question

我正在尝试删除工作表中所有在其顶行中包含某些文本的列。相同的代码只带有与文本匹配的单元格的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

Answer 1

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

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)

Answer 2

在删除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，因为它的命名错误。

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

2 个答案: