选择定义的值后删除一组列

时间:2014-07-21 16:49:53

标签: excel vba excel-vba excel-2007

在工作表中,我有一张工作表/列表,用户应在其中选择是/否,具体取决于要从哪个工作表中保留/删除哪些列。
当用户选择时,由于列已经存在,所以不会发生任何事情,但如果他选择,则必须删除其他工作表的列。

到目前为止,我做了这段代码,但没有任何改变:

选项明确 选项基础1 Const TEMPLATE_SHE As String =“TemplateSHE”

Sub GenerateSHE()

Dim ws, wsh As Worksheet, Cel1 As Range
Dim Var1 As String
Dim Col_num As Integer
Dim Col_name As String
Dim MyRange As Range

 Set ws = Worksheets(4)
            For Each Cel1 In ws.UsedRange
               If (Cel1.Value = "NO") Then
                   For Each wsh In ActiveWorkbook.Sheets
                          With wsh.Name <> TEMPLATE_SHE
                                Col_num = .Range("A1").End(xlToRight).Column
                                Set MyRange = .Range(.Cells(1, 1), .Cells(1, Col_num)).Cells.Find(Col_name)
                                If Left(MyRange, 3) = "LEW" Then
                                    Columns("AY:BC").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 3) = "RMS" Then
                                    Columns("AT:AX").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 3) = "AMS" Then
                                    Columns("AR:AS").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 2) = "MM" Then
                                    Columns("AM:AQ").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 2) = "QM" Then
                                    Columns("AH:AL").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 3) = "TEM" Then
                                    Columns("AC:AG").Delete Shift:=xlToLeft
                                    ElseIf Left(MyRange, 3) = "LMM" Then
                                    Columns("X:AB").Delete Shift:=xlToLeft
                                End If
                        End With
                   Next wsh
               End If
            Next
        Set ws = Nothing
End Sub

有人可以帮我纠正我的代码吗?

1 个答案:

答案 0 :(得分:0)

这里有适用于我的解决方案,它与我的开始完全不同:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, [B2:E5]) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target.Value = "YES" Then Exit Sub
  Call Del_Colns(Target.EntireRow.Cells(1, 1).Value, _
                         Target.EntireColumn.Cells(1, 1).Value)
End Sub

Private Sub Del_Colns(sheeet As String, colns As String)
Dim i As Long

  With Worksheets(sheeet).UsedRange.Rows(1)
    For i = .Cells.Count To 1 Step -1
      If InStr(1, .Cells(1, i).Formula, colns) = 1 Then
        .Cells(1, i).EntireColumn.Delete
      End If
    Next i
  End With

End Sub