Split Excel foglio in file multipli a seconda della colonna Utilizzando VBA
Hai un big data su un foglio Excel e devi distribuire quel foglio in più fogli, in base ad alcuni dati in una colonna? Questo compito molto semplice ma richiede tempo.
Ad esempio, ho questi dati. Questi dati hanno una colonna denominata Date, Writer e Title. 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. Rinomina il foglio. Ripeti tutti i 5 passaggi precedenti per ciascuno.
In questo esempio, ho solo tre nomi. Immagina di avere centinaia di nomi.
Come suddivideresti 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, attenersi alla seguente procedura.
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
'clearing filter if any
On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0
Dim lsrClm As Long
Dim lstRow As Long
'counting last used row
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim uniques As Range
Dim clm As String, clmNo As Long
On Error GoTo handler
clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
clmNo = Range(clm & "1").Column
Set uniques = Range(clm & "2:" & clm & lstRow)
'Calling Remove Duplicates to Get Unique Names
Set uniques = RemoveDuplicates(uniques)
Call CreateSheets(uniques, clmNo)
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
MsgBox "Well Done!"
Exit Sub
Data.ShowAllData
handler:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Function RemoveDuplicates(uniques As Range) As Range
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(uniques 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 eseguirai la procedura SplitIntoSheets (), il foglio verrà diviso in più fogli, in base alla colonna data. Puoi aggiungere un pulsante sul foglio e assegnargli questa macro.
Come funziona
Il codice precedente ha due procedure e una funzione. Due procedure sono SplitIntoSheets (), CreateSheets (uniques As Range, clmNo As Long) e una funzione è RemoveDuplicates (uniques As Range) As Range. La prima procedura è SplitIntoSheets (). Questa è la procedura principale. Questa procedura imposta le variabili e RemoveDuplicates per ottenere nomi univoci da una determinata colonna e quindi passa tali nomi a CreateSheets per la creazione di fogli.
RemoveDuplicates accetta un argomento che è l’intervallo che contiene il nome.
Rimuove i duplicati da essi e restituisce un oggetto intervallo che contiene nomi univoci.
Ora viene chiamato CreateSheets. Ci vogliono due argomenti. Prima i nomi univoci e poi la colonna n. da cui tratteremo i dati. Ora CreateSheets prende ogni nome da utenti unici e filtra il numero di colonna specificato per ogni nome. Copia i dati filtrati, aggiunge un foglio e incolla i dati lì. E i tuoi dati vengono suddivisi in fogli diversi in pochi secondi.
Puoi scaricare il file qui.
Dividi in fogli
Come usare il file:
-
Copia i tuoi dati su Sheet1. Assicurati che inizi da A1.
Fare clic sul pulsante Dividi in fogli * Immettere la lettera della colonna da cui si desidera dividere. Fare clic su OK.
-
Vedrai un messaggio come questo. Il tuo foglio è diviso.
Spero che l’articolo sulla suddivisione dei dati in fogli separati ti sia stato utile. Se hai dei dubbi su questa o su qualsiasi altra caratteristica di Excel, sentiti libero di chiederlo nella sezione commenti qui sotto.