删除所有其他列

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

换句话说，我想让宏做相反的事情吗？

代码：

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

来源

2011-12-16 Stravan A

如果你在这里发表您的代码，你将有更多的运气，像megashares网站往往是由企业政策受阻。 – stuartd 2011-12-16 16:45:24

而不是张贴Excel文件，你应该显示一些代码，解释代码在做什么，你想要它做什么，以及到目前为止你试图让它工作。否则恐怕你不会得到任何帮助（我非常怀疑任何人都想打开一些从megashare下载的随机Excel文件...）。 – Quasdunk 2011-12-16 16:46:39

我将采取的方法是通过循环的列，搜索每个依次图案阵列中，未发现delete一个时。

这是你的小组的rewoked其它版本：

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

来源

2011-12-17 20:21:52

删除所有其他列

回答

相关问题