Dividi il foglio Excel in più file in base alla colonna utilizzando VBA

Hai un big data su foglio excel e hai bisogno di distribuire quel foglio in più fogli, sulla base di alcuni dati in una colonna? Questo compito molto semplice ma che richiede tempo.

Ad esempio, ho questi dati. Questi dati hanno una colonna denominata Data, scrittore e Titolo. La colonna dello scrittore ha il nome dello scrittore del rispettivo titolo. Voglio ottenere i dati di ogni scrittore in fogli separati.

Per farlo manualmente, devo fare quanto segue:

Filtra un nome
Copia i dati filtrati
Aggiungi un foglio
Incolla i dati
Rinominare il foglio
Ripeti tutti i 5 passaggi precedenti per ciascuno.

In questo esempio, ho solo tre nomi. Immagina di avere centinaia di nomi. Come divideresti i dati in fogli diversi? Ci vorrà molto tempo e prosciugherà anche te.
Per automatizzare il processo precedente di suddivisione del foglio in più fogli, seguire questi passaggi.

Premi Alt+F11. Questo aprirà VB Editor per Excel
Aggiungi un nuovo modulo
Copia sotto il codice nel modulo.

 Sub SplitIntoSheets() With Application .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Activate Sheet1.Activate 'cancellando il filtro se presente On Error Resume Next Sheet1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long 'contando l'ultima riga utilizzata lstRow = Celle (Rows.Count, 1).End(xlUp).Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo handler clm = Application.InputBox("Da quale colonna vuoi creare i file" & vbCrLf & "Eg A,B,C,AB,ZA ecc.") clmNo = Range(clm & "1").Column Set uniques = Range(clm & "2:" & clm & lstRow) 'Chiamata Rimuovi duplicati per ottenere set di nomi univoci uniques = RemoveDuplicates(uniques) Chiama CreateSheets(uniques, clmNo) With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Activate MsgBox "Ben fatto!" Exit Sub Data.ShowAllData handler: With Application .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Funzione RemoveDuplicates (unici come intervallo) come intervallo ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets("uniques").Activate On Error GoTo 0 uniques.Copy Cells(2, 1).Activate ActiveCell.PasteSpecial xlPasteValues Range("A1") .Value = "uniques" Dim lstRow As Long lstRow = Cells(Rows.Count, 1).End(xlUp).Row Range("A2:A" & lstRow).Select ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns :=1, Header:=xlNo lstRow = Cells(Rows.Count, 1).End(xlUp).Row Set RemoveDuplicates = Range("A2:A" & lstRow) End Function Sub CreateSheets (unici As Range, clmNo As Long) Dim lstClm As Long Dim lstRow As Long For Each Unique In uniques Sheet1.Activate lstRow = Cells(Rows.Count, 1).End(xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Dim dataSet As Range Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.AutoFilter field:=clmNo, Criteria1:=unique.Value lstRow = Cells(Rows.Count, 1).End( xlUp).Row lstClm = Cells(1, Columns.Count).End(xlToLeft).Column Debug.Print lstRow; lstClm Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm)) dataSet.Copy Sheets.Add ActiveSheet.Name = unique.Value2 ActiveCell.PasteSpecial xlPasteAll Next unique End Sub

Quando correrai Dividi in Fogli() procedura, il foglio verrà suddiviso in più fogli, in base alla colonna data. Puoi aggiungere un pulsante sul foglio e assegnargli questa macro.

Come funziona
Il codice sopra ha due procedure e una funzione. Due procedure sono SplitIntoSheets(), CreateSheets(unique As Range, clmNo As Long) e una funzione è RemoveDuplicates (unici come intervallo) come intervallo.

La prima procedura è Dividi in Fogli(). Questa è la procedura principale. Questa procedura imposta le variabili e Rimuovi duplicati per ottenere nomi univoci da una determinata colonna e quindi passa quei nomi a Crea Fogli per la creazione di fogli.

Rimuovi duplicati prende un argomento che è range che contiene name. Rimuove i duplicati da loro e restituisce un oggetto intervallo che contiene nomi univoci.

Ora Crea Fogli è chiamato. Ci vogliono due argomenti. Prima i nomi univoci e poi la colonna n. da cui tratterremo i dati. Ora Crea Fogli prende ogni nome da univoci e filtra il numero di colonna dato per ogni nome. Copia i dati filtrati, aggiunge un foglio e incolla lì i dati. E i tuoi dati vengono suddivisi in fogli diversi in pochi secondi.

Puoi scaricare il file qui.
Dividi in fogli

Come utilizzare il file:

- Copia i tuoi dati su Foglio1. Assicurati che inizi da A1.

- Fare clic sul pulsante Dividi in fogli
- Inserisci la lettera della colonna da cui vuoi dividere. Fare clic su OK.

- Vedrai un prompt come questo. Il tuo foglio è diviso.

Spero che l'articolo sulla suddivisione dei dati in fogli separati ti sia stato utile. Se hai dubbi su questa o su qualsiasi altra funzionalità di Excel, non esitare a chiedere nella sezione commenti qui sotto.