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 に答える