Question

Option Explicit
Sub DleteColumns()

Dim objWorkbook As Workbook
Dim i As Integer
Dim keepColumn As Boolean
Dim currentColumn As Integer
Dim columnHeading As String
Dim ws As Worksheet

'This is temporary for testing this one below

    Application.DisplayAlerts = False

    currentColumn = 1
    'open the workbook with data
    DoEvents
    Set objWorkbook = Workbooks.Open( _
    "H:\C_Files\xls\a_C_Track_20171101.xls")
    'Do a pause
    Application.Wait (Now + TimeValue("0:00:10"))
    ThisWorkbook.Activate
    Set ws = ActiveSheet
    'Stop
    'read the data from the first columns
    For i = 1 To 1

    currentColumn = 1
        While currentColumn <= ActiveSheet.UsedRange.Columns.Count
            columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

         'CHECK WHETHER TO KEEP THE COLUMN
            keepColumn = False

            If columnHeading = "#reason" Then keepColumn = True
            If columnHeading = "first_name" Then keepColumn = True
            If columnHeading = "last_name" Then keepColumn = True
            If columnHeading = "employer_name" Then keepColumn = True
            If columnHeadimg = "city" Then keepColumn = True
            If columnHeading = "state" Then keepColumn = True
            If columnHeading = "date_of_birth" Then keepColumn = True
            If columnHeading = "ssn" Then keepColumn = True

            If keepColumn Then
                currentColumn = currentColumn + 1
            Else
                ActiveSheet.Columns(currentColumn).Delete
            End If

            'LASTLY AN ESCAPE IN CASE THE SHEET HAS NO COLUMNS LEFT
             If (ActiveSheet.UsedRange.Address = "$A$1") And 
                 (ActiveSheet.Range("$A$1").text = "") Then Exit Sub
        Wend

           Next i
     Stop
    'ActiveWorkbook.Save
    'objWorkbook.Close
     ActiveWorkbook.Close SaveChanges:=True
    End Sub

Answer 1

据我所知，唯一真正的问题是，由于ThisWorkbook.Activate语句，您当前正在将更改应用于包含宏的工作簿中的活动工作表。只删除那一行可能意味着你的宏可以按照你想要的那样工作。

然而，ActiveSheet的不断引用并不是一个好主意。以下代码对其进行了更改，以便它使用您的ws对象。虽然代码仍然将ws设置为ActiveSheet（因此在我看来仍然不是特别好，因为ActiveSheet将是上次保存工作簿时处于活动状态的工作表）已经在评论中加入了一些可能更合适的替代方法。

Option Explicit
Sub DleteColumns()

    Dim objWorkbook As Workbook
    Dim i As Integer
    Dim keepColumn As Boolean
    Dim columnHeading As String
    Dim ws As Worksheet

    Application.DisplayAlerts = False

    'open the workbook with data
    Set objWorkbook = Workbooks.Open("H:\C_Files\xls\a_C_Track_20171101.xls")

    Set ws = ActiveSheet
    'Better than the above line would be something like
    'Set ws = objWorkbook.Worksheets("Sheet_I_want_to_process")
    'or maybe
    'Set ws = objWorkbook.Worksheets(1)

    With ws
        'Loop through each column in the sheet, working from right to left
        For i = .UsedRange.Columns(.UsedRange.Columns.Count).Column To 1 Step -1
            columnHeading = .Cells(1, i).Value

            'CHECK WHETHER TO KEEP THE COLUMN
            keepColumn = False

            If columnHeading = "#reason" Then keepColumn = True
            If columnHeading = "first_name" Then keepColumn = True
            If columnHeading = "last_name" Then keepColumn = True
            If columnHeading = "employer_name" Then keepColumn = True
            'Ensure you type your variable names correctly - "columnHeadimg" in your
            'code would have stopped your program running
            If columnHeading = "city" Then keepColumn = True
            If columnHeading = "state" Then keepColumn = True
            If columnHeading = "date_of_birth" Then keepColumn = True
            If columnHeading = "ssn" Then keepColumn = True

            If Not keepColumn Then
                .Columns(i).Delete
            End If
        Next

        'Only save if there is something left
        If .UsedRange.Address <> "$A$1" Or .Range("$A$1").Text <> "" Then
            objWorkbook.Close SaveChanges:=True
        End If
    End With
    Application.DisplayAlerts = False
End Sub

打开工作簿，打开后再回到sub的开头，

1 个答案: