conservare solo colonne di interesse

Question

Buonasera,

ho la necessità quotidiana di lavorare su un file che estraggo da un sistema di lavoro che contiene un centinaio di colonne ma quelle che mi interessano sono le solite 15. Chiedo indicazioni per poter creare una maschera in cui incollare il mio file quotidiano e che automaticamente cancelli tutte le colonne che non sono necessarie e tenga solo quelle che ho selezionato nella maschera. Preciso che le colonne hanno sempre la medesima intestazione in ogni file che scarico quotidianamente.

Grazie e buona serata.

Answer 1

Prova con questa routine che, agendo sul foglio attivo, elimina tutte le colonne che nelle intestazioni non presenti la descrizione inserita nella costante "sIntestazioniDaMantenere"

'---

Sub EliminaColonneSuperflue()

   'Riferimento alla cella che contiene la prima intestazione

   Const sCellaIntestazioni1 As String = "A1"

   'Elenco delle intestazioni di colonna da mantenere

   'L'elenco deve essere delimitato dalla virgola senza spazi tra una voce e l'altra

   Const sIntestazioniDaMantenere As String = "Colonna1,Colonna3,Colonna5,Colonna7,Colonna9,Colonna11," & _

                                              "Colonna13,Colonna15,Colonna17,Colonna19"

   Dim rngColonne As Range

   Dim arrIntestazioni As Variant

   Dim NumCol As Long

   Dim arrIntestazionDaMantenere As Variant

   Dim i As Long

   Dim vMatch As Variant

   With Application

      .Calculation = xlCalculationManual

      .ScreenUpdating = False

      .EnableEvents = False

   End With

   arrIntestazionDaMantenere = Split(sIntestazioniDaMantenere, ",")

   With ActiveSheet.Range(sCellaIntestazioni1).CurrentRegion.Resize(1)

      Set rngColonne = .Cells

      arrIntestazioni = .Value

      NumCol = .Columns.Count

   End With

   For i = NumCol To 1 Step -1

      vMatch = Application.Match(arrIntestazioni(1, i), arrIntestazionDaMantenere, 0)

      If IsError(vMatch) Then

          rngColonne(1, i).EntireColumn.Delete

      End If

   Next i

   With Application

      .Calculation = xlCalculationAutomatic

      .ScreenUpdating = True

      .EnableEvents = True

   End With

End Sub

'---

Qui trovi anche un file di test: File Test

ciao