Question

此代码是一个宏，用于搜索不同工作表中的某些值并删除其列。但是，如果我想删除所有其他列而不是并保留我正在搜索的内容，该怎么办？

换句话说，我希望宏做相反的事情吗？

代码：

    Sub Level()
Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim wsSkador As Worksheet
Dim ws As Worksheet
With Application
    calcmode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
    myStrings = Array("Apple", "Banan")
    For Each ws In ActiveWorkbook.Worksheets
With ws.Range("A6:EE6")

        For I = LBound(myStrings) To UBound(myStrings)
            Do
               Set FoundCell = .Find(What:=myStrings(I), _
                                           After:=.Cells(.Cells.Count), _
                                           LookIn:=xlFormulas, _
                                           LookAt:=xlPart, _
                                           SearchOrder:=xlByRows, _
                                           SearchDirection:=xlNext, _
                                           MatchCase:=False)

                If FoundCell Is Nothing Then
                    Exit Do
                Else
                    FoundCell.EntireColumn.Delete
                End If
            Loop
        Next I
End With
    Next ws
    End Sub

Answer 1

我将采用的方法是遍历列，在模式数组中依次搜索每个列，在未找到时删除。

这是你的Sub的重复版：

Sub Level()
    Dim calcmode As Long
    Dim ViewMode As Long
    Dim myStrings As Variant
    Dim FoundCell As Range
    Dim I As Long
    Dim wsSkador As Worksheet
    Dim ws As Worksheet
    Dim cl As Range
    Dim Found As Boolean
    Dim DeleteRange As Range

    On Error GoTo EH

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    myStrings = Array("a", "s")
    For Each ws In ActiveWorkbook.Worksheets
        Set DeleteRange = Nothing
        For Each cl In ws.[A6:EE6]
            If cl <> "" Then
                Found = False
                For I = LBound(myStrings) To UBound(myStrings)
                    If LCase$(cl.Formula) Like LCase$("*" & myStrings(I) & "*") Then
                        Found = True
                        Exit For
                    End If
                Next I
                If Not Found Then
                    If DeleteRange Is Nothing Then
                        Set DeleteRange = cl
                    Else
                        Set DeleteRange = Union(DeleteRange, cl)
                    End If
                End If
            End If
        Next cl
        If Not DeleteRange Is Nothing Then
            DeleteRange.EntireColumn.Delete
        End If
    Next ws
    With Application
        .Calculation = calcmode
        .ScreenUpdating = True
        .EnableEvents = True
    End With
Exit Sub
EH:
    Debug.Assert
    'Resume  ' Uncomment this to retry the offending code
End Sub

删除所有其他列

1 个答案: