查找并删除列

Question

我想在某一列中查找文本，如果找到则删除相应的列。

它删除第一个找到的列，但在下一次迭代时出错。

当我删除该列时，FindNext 方法给出错误。

无法获取Range类的FindNext属性

Private Sub ClearInPlanCells(strSearch As String, wrkSheetName As String)
    Dim rngFound As Range
    Application.ScreenUpdating = False
    
    With Worksheets(wrkSheetName).Cells
        Set rngFound = .Find(strSearch, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
            strAddr = rngFound.Address
            Set rngFound = .Find(strSearch, LookIn:=xlValues, lookat:=xlWhole)
           ' On Error Resume Next
            Do
                'MsgBox (rngFound.Address)
                Sheets(wrkSheetName).Columns(rngFound.Column).EntireColumn.Delete
                Set rngFound = .FindNext(rngFound)
            Loop While rngFound.Address <> strAddr
        End If
    End With
    Application.ScreenUpdating = True
    End
End Sub

Answer 1

您无法执行

FindNext(After:=rngFound)

，因为您已删除

rngFound

。如果您单步执行，删除后您会看到

rngFound

变成了

<object required>

。我建议将所有列保存到一个变量中，然后在循环后删除它们。

Sub ClearInPlanCells(strSearch As String, wrkSheet As Worksheet)
    
    Dim rngFound As Range
    Dim DeleteColumns As Range
    
    Application.ScreenUpdating = False
    
    With wrkSheet.Cells
        Set rngFound = .Find(strSearch, LookIn:=xlValues, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
            Dim strAddr As String
            strAddr = rngFound.Address
            
            Do
                If DeleteColumns Is Nothing Then
                    Set DeleteColumns = rngFound.EntireColumn
                Else
                    Set DeleteColumns = Union(DeleteColumns, rngFound.EntireColumn)
                End If
                
                Set rngFound = .FindNext(rngFound)
            Loop While rngFound.Address <> strAddr
            
        End If
        
    End With
    
    Application.ScreenUpdating = True
    
    If Not DeleteColumns Is Nothing Then DeleteColumns.EntireColumn.Delete

End Sub

我将参数

wrkSheetName As String

更改为

wrkSheet As Worksheet

，因为直接将工作表对象传递到子中更有意义，并且避免了不知道工作表名称属于哪个工作簿的问题。

Answer 2

删除条件列

一个简单的测试

Sub DeleteCriteriaColumnsTEST()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    DeleteCriteriaColumns wb, "Sheet1", "Yes"

End Sub

方法

Sub DeleteCriteriaColumns( _
        ByVal wb As Workbook, _
        ByVal WorksheetID As Variant, _
        ByVal SearchString As String)

    Application.ScreenUpdating = False
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(WorksheetID)
    If ws.FilterMode Then ws.ShowAllData
    
    Dim rg As Range: Set rg = ws.UsedRange

    Dim urg As Range, crg As Range, cel As Range
    
    For Each crg In rg.Columns
        Set cel = crg.Find(SearchString, , xlFormulas, xlWhole)
        If Not cel Is Nothing Then
            If urg Is Nothing Then Set urg = cel Else Set urg = Union(urg, cel)
        End If
    Next crg

    If Not urg Is Nothing Then urg.EntireColumn.Delete

    Application.ScreenUpdating = True

End Sub