Удаление всех столбцов, кроме столбцов с определенными заголовками

Question

Я пытаюсь отформатировать экспортированные данные и удалить несколько столбцов. Я хочу сохранить столбцы с определенными заголовками. Для удобства, если у меня 15 столбцов и вы хотите сохранить столбцы со следующими заголовками;

Государственный Город Имя Клиент Продукт

Меня беспокоит то, что данные я экспорт может изменить и столбцы могут быть добавлены в будущем. Я хочу иметь возможность отфильтровывать нежелательные столбцы и просто хранить вышеупомянутые столбцы.

Редактировать: Я использую Excel, и в моей жизни я никогда не писал строки кода. Когда-либо.

Answer 1

Попробуйте этот.

Итерации по столбцам в обратном порядке, проверка заголовков в окне выбора и удаление по мере необходимости.

Sub deleteIrrelevantColumns() 
    Dim currentColumn As Integer 
    Dim columnHeading As String 

    ActiveSheet.Columns("L").Delete 

    For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1 

     columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value 

     'CHECK WHETHER TO KEEP THE COLUMN 
     Select Case columnHeading 
      Case "State", "City", "Name", "Client", "Product" 
       'Do nothing 
      Case Else 
       'Delete if the cell doesn't contain "Homer" 
       If Instr(1, _ 
        ActiveSheet.UsedRange.Cells(1, currentColumn).Value, _ 
        "Homer",vbBinaryCompare) = 0 Then 

        ActiveSheet.Columns(currentColumn).Delete 

       End If 
     End Select 
    Next 

End Sub 

Answer 2

Я предполагаю, что мы говорим о Excel здесь. Если так итерация через ваши столбцы с циклом while и принятие решения сохранить или не держать, нужно сделать трюк.

Sub deleteIrrelevantColumns() 
    Dim keepColumn As Boolean 
    Dim currentColumn As Integer 
    Dim columnHeading As String 

    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 = "State" Then keepColumn = True 
     If columnHeading = "City" Then keepColumn = True 
     If columnHeading = "Name" Then keepColumn = True 
     If columnHeading = "Client" Then keepColumn = True 
     If columnHeading = "Product" Then keepColumn = True 


     If keepColumn Then 
     'IF YES THEN SKIP TO THE NEXT COLUMN, 
      currentColumn = currentColumn + 1 
     Else 
     'IF NO DELETE THE COLUMN 
      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 

End Sub 

Answer 3

У меня была аналогичная проблема, и это код, который работал для меня. Я думаю, что это намного проще.

Range("A1").Select 

Do Until ActiveCell.Value = "" 

    If ActiveCell.Value = "Forecast Status" _ 
     Or ActiveCell.Value = "Amount " _ 
     Or ActiveCell.Value = "Service Booking Value " _ 
     Or ActiveCell.Value = "Transaction Number" _ 
     Or ActiveCell.Value = "Last Modified by" _ 
     Or ActiveCell.Value = "Last Modified Date" _ 
     Or ActiveCell.Value = "T# Comparison" _ 
     Or ActiveCell.Value = "Amount Comparison" _ 
     Or ActiveCell.Value = "Forecast Status Comparison" _ 
     Or ActiveCell.Value = "First Ship Date Comparison" Then 

     ActiveCell.Offset(0, 1).Select 

    Else 

     ActiveCell.EntireColumn.Select 
     Selection.Delete Shift:=xlToLeft 
     Selection.End(xlUp).Select 

    End If 
Loop