如何更改宏以删除列列表,因为它现在可以删除列中没有的所有内容。
我已经尝试但无法得到它。
由于
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
End Sub
答案 0 :(得分:1)
你不会只改变这一行
If boolFound = False Then
要检查True吗?
If boolFound = True Then