0

如何更改宏以删除列列表，因为它现在可以删除不在列中的所有内容。

我已经尝试过，但无法得到它。

谢谢

Sub DeleteColumns()

Dim ws As Worksheet
Dim ColList As String, ColArray() As String
Dim LastCol As Long, i As Long, j As Long
Dim boolFound As Boolean
Dim delCols As Range

On Error GoTo Whoa

Application.ScreenUpdating = False

'~~> Set your sheet here
Set ws = Sheets("360")

'~~> List of columns you want to keep. You can keep adding or deleting from this.
'~~> Just ensure that the column names are separated by a COMMA
'~~> The names below can be in any case. It doesn't matter
ColList = "{TOKEN:ATTRIBUTE_3}, {TOKEN:ATTRIBUTE_4}"

'~~> Create an array for comparision
ColArray = Split(ColList, ",")

'~~> Get the last column
LastCol = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False).Column

'~~> Loop through the Cols. Since there are only 100 Columns
'~~> I am not using .Find and .FindNext
'~~> If you are interested in learning how .Find and .Findnext
'~~> works then see this link
'~~> http://siddharthrout.wordpress.com/2011/07/14/find-and-findnext-in-excel-vba/
For i = 1 To LastCol
    boolFound = False
    '~~> Checking of the current cell value is present in the array
    For j = LBound(ColArray) To UBound(ColArray)
        If UCase(Trim(ws.Cells(1, i).Value)) = UCase(Trim(ColArray(j))) Then
            '~~> Match Found
            boolFound = True
            Exit For
        End If
    Next
   '~~> If not match not found
    If boolFound = False Then
        If delCols Is Nothing Then
            Set delCols = ws.Columns(i)
        Else
            Set delCols = Union(delCols, ws.Columns(i))
        End If
    End If
Next i

'~~> Act on columns
If Not delCols Is Nothing Then delCols.Delete

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue

结束子

4

1 回答 1

1

难道你不只是改变这条线

If boolFound = False Then

改为检查 True ？

If boolFound = True Then
于 2013-08-28T14:42:07.457 回答