Μετάβαση στο κύριο περιεχόμενο

Πώς να χωρίσετε δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη στο Excel;

Ας υποθέσουμε ότι έχετε ένα φύλλο εργασίας με τεράστιες σειρές δεδομένων και τώρα, πρέπει να χωρίσετε τα δεδομένα σε πολλά φύλλα εργασίας με βάση το Όνομα στήλη (δείτε το παρακάτω στιγμιότυπο οθόνης) και τα ονόματα εισάγονται τυχαία. Ίσως μπορείτε να τα ταξινομήσετε πρώτα και μετά να τα αντιγράψετε και να τα επικολλήσετε ένα προς ένα σε άλλα νέα φύλλα εργασίας. Αλλά αυτό θα χρειαστεί την υπομονή σας για να αντιγράψετε και να επικολλήσετε επανειλημμένα. Σήμερα, θα μιλήσω για μερικά γρήγορα κόλπα για την επίλυση αυτού του έργου.

έγγραφα διαχωρισμού εγγράφων ανά στήλες 1

Διαχωρίστε τα δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη με τον κώδικα VBA

Διαχωρίστε τα δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη με το Kutools για Excel


Διαχωρίστε τα δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη με τον κώδικα VBA

Εάν θέλετε να διαχωρίσετε τα δεδομένα με βάση την τιμή της στήλης γρήγορα και αυτόματα, ο ακόλουθος κώδικας VBA είναι μια καλή επιλογή. Κάντε το ως εξής:

1. Κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο παράθυρο της ενότητας.

Sub Splitdatabycol()
'updateby Extendoffice
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3. Στη συνέχεια, πατήστε F5 κλειδί για την εκτέλεση του κώδικα και εμφανίζεται ένα πλαίσιο προτροπής για να σας υπενθυμίσει ότι επιλέγετε τη γραμμή κεφαλίδας, δείτε το στιγμιότυπο οθόνης:

έγγραφα διαχωρισμού εγγράφων ανά στήλες 7

4. Και μετά, κάντε κλικ στο OK κουμπί και στο δεύτερο πλαίσιο προτροπής, επιλέξτε τα δεδομένα της στήλης με βάση τα οποία θέλετε να διαχωρίσετε, δείτε το στιγμιότυπο οθόνης:

έγγραφα διαχωρισμού εγγράφων ανά στήλες 8

5. Στη συνέχεια, κάντε κλικ στο κουμπί OKκαι όλα τα δεδομένα στο ενεργό φύλλο εργασίας χωρίζονται σε πολλά φύλλα εργασίας με βάση την τιμή της στήλης. Και τα φύλλα εργασίας διαχωρίζονται με τα ονόματα των διαχωρισμένων κελιών. Δείτε το στιγμιότυπο οθόνης:

έγγραφα διαχωρισμού εγγράφων ανά στήλες 2

Note: Τα διαχωρισμένα φύλλα εργασίας τοποθετούνται στο τέλος του βιβλίου εργασίας όπου βρίσκεται το κύριο φύλλο εργασίας.


Διαχωρίστε τα δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη με το Kutools για Excel

Ως αρχάριος του Excel, αυτός ο μακρύς κώδικας VBA είναι κάπως δύσκολος για εμάς, και οι περισσότεροι από εμάς δεν γνωρίζουμε καν πώς να τροποποιήσουμε τον κώδικα ως ανάγκη μας. Εδώ, θα σας παρουσιάσω ένα πολυλειτουργικό εργαλείο--Kutools για Excel, της Διαχωρίστε τα δεδομένα Το βοηθητικό πρόγραμμα όχι μόνο μπορεί να σας βοηθήσει να χωρίσετε δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη, αλλά και να διαχωρίσετε τα δεδομένα με βάση τον αριθμό.

Σημείωση:Για να το εφαρμόσετε Διαχωρίστε τα δεδομένα, πρώτα, πρέπει να κατεβάσετε το Kutools για Excelκαι, στη συνέχεια, εφαρμόστε τη λειτουργία γρήγορα και εύκολα.

Μετά την εγκατάσταση Kutools για Excel, κάντε το ως εξής:

1. Επιλέξτε το εύρος δεδομένων που θέλετε να διαχωρίσετε.

2. Κλίκ Kutools Plus > Φύλλο εργασίας > Διαχωρίστε τα δεδομένα, δείτε το στιγμιότυπο οθόνης:

έγγραφα διαχωρισμού εγγράφων ανά στήλες 3

3. Στην Διαχωρισμός δεδομένων σε πολλά φύλλα εργασίας πλαίσιο διαλόγου, πρέπει:

1). Επιλέγω Ειδική στήλη επιλογή του Διαχωρισμός με βάση ενότητα και επιλέξτε την τιμή της στήλης στην οποία θέλετε να διαιρέσετε τα δεδομένα με βάση την αναπτυσσόμενη λίστα. (Εάν τα δεδομένα σας έχουν κεφαλίδες και θέλετε να τα εισαγάγετε σε κάθε νέο φύλλο εργασίας, διαβάστε Τα δεδομένα μου έχουν κεφαλίδες επιλογή.)

2). Στη συνέχεια, μπορείτε να καθορίσετε τα ονόματα των φύλλων εργασίας που διαχωρίζονται, κάτω από το Νέο όνομα φύλλων εργασίας ενότητα, καθορίστε τους κανόνες ονομάτων φύλλου εργασίας από το Κανόνες που αναπτυσσόμενη λίστα, μπορείτε να προσθέσετε το Πρόθεμα or Κατάληξη για τα ονόματα των φύλλων επίσης.

3). Κάντε κλικ στο OK κουμπί. Δείτε το στιγμιότυπο οθόνης:

έγγραφα διαχωρισμού εγγράφων ανά στήλες 4

4. Τώρα τα δεδομένα χωρίζονται σε πολλά φύλλα εργασίας σε ένα νέο βιβλίο εργασίας.

έγγραφα διαχωρισμού εγγράφων ανά στήλες 5

Κάντε κλικ για λήψη του Kutools για Excel και δωρεάν δοκιμή τώρα!


Διαχωρίστε τα δεδομένα σε πολλά φύλλα εργασίας με βάση τη στήλη με το Kutools για Excel

Kutools για Excel περιλαμβάνει περισσότερα από 300 εύχρηστα εργαλεία Excel. Δωρεάν δοκιμή χωρίς περιορισμό σε 30 ημέρες. Κατεβάστε τη δωρεάν δοκιμή τώρα!


Σχετικό άρθρο:

Πώς να διαχωρίσετε τα δεδομένα σε πολλά φύλλα εργασίας κατά τον αριθμό των σειρών;

Τα καλύτερα εργαλεία παραγωγικότητας γραφείου

🤖 Kutools AI Aide: Επανάσταση στην ανάλυση δεδομένων με βάση: Ευφυής Εκτέλεση   |  Δημιουργία κώδικα  |  Δημιουργία προσαρμοσμένων τύπων  |  Αναλύστε δεδομένα και δημιουργήστε γραφήματα  |  Επίκληση Λειτουργιών Kutools...
Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

Περιγραφή


Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (312)
Rated 5 out of 5 · 2 ratings
This comment was minimized by the moderator on the site
Sub SplitDataByColWorkbook()
Dim lr As Long
Dim ws As Worksheet
Dim vcol As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
Dim xWS As Workbook
Dim wb As Workbook


Set wb = ThisWorkbook
Set ws = wb.Sheets(1) ' Assuming you want to work with the first sheet in the workbook

On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Select Header Rows", Type:=8)
If xTRg Is Nothing Then Exit Sub

On Error Resume Next
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Select Split Column", Type:=8)
If xVRg Is Nothing Then Exit Sub

vcol = xVRg.Column
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"

Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet'!A1)") Then
Set xWS = Workbooks.Add
Else
Set xWS = Workbooks.Add
End If

Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Activate

For i = (titlerow + xTRg.Rows.Count) To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next

myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear

For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
Set xWS = Workbooks.Add
Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWSTRg.Range("A" & (titlerow + xTRg.Rows.Count))
xWSTRg.Columns.AutoFit
xWS.SaveAs myarr(i) & ".xlsx" ' Change the file name as needed
xWS.Close SaveChanges:=False
Next

ws.AutoFilterMode = False
wb.Activate
Application.DisplayAlerts = True
End Sub
This comment was minimized by the moderator on the site
First of all, thank you for the macro.

I would like to ask if there is any way to maintain the column widths. My 'original' tab was completely formatted. However, after running the macro, it loses the column formatting and appears quite messy.

English is not my first language (sorry).

Thank you again!
Rated 5 out of 5
This comment was minimized by the moderator on the site
The original header is not copied in the split sheet.
This comment was minimized by the moderator on the site
This works wonderfully, thank you very much!!! Huge time-saver.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Hello,

I am having a hard time getting this code to work. When I run it, it just creates a duplicate sheet and does not split columns into multiple sheets.

I do have values that exceed 31 characters as well as special characters such as "-" and "()" in my column, how can I account for that without a lot of manual changes?
This comment was minimized by the moderator on the site
This worked great!!! One question... my formulas didn't transfer to each sheet correctly. What do I need to do differently to transfer the formulas?
Thank you!!!!!
This comment was minimized by the moderator on the site
Nice code, but it just copied everything to the new tables, named correctly though. So, the data filtering did not work at all, just copy paste.
This comment was minimized by the moderator on the site
When I run this using a small amount of data like the example it works. I'm trying to use this on a database with 400k + rows of data. When I run the macro, a second tab is created with just the header row and no data.
This comment was minimized by the moderator on the site
Hello, Ryan,

As you mentioned, the code works well for small data ranges, if there are lots of data, the code will not work properly.
In such situations, I recommend using the "Split Data" feature offered by Kutools for Excel. This powerful feature can greatly assist you in managing large amounts of data. To take advantage of this feature, you can download and install Kutools for Excel, which is available for a 30-day free trial.

Please have a try, thank you!
This comment was minimized by the moderator on the site
I've come across many solutions in VBA message boards for parsing data into worksheets or columns based upon filtering a particular column, but they all require a bit of tinkering and customization. What makes this so brilliant is that it is dynamic, user-friendly even for beginners (which gives it shareable utility), and copy/paste ready.

You rock.
This comment was minimized by the moderator on the site
Hi, Dane,
Thanks for your comment, glad this can help you! Have a good day!
This comment was minimized by the moderator on the site
When I try to split data from a different sheet, it copies and pastes the entire sheet into one sheet instead of multiple sheets. Could this be because the naming convention of the sheet I'm trying to split is similar to another sheet?
This comment was minimized by the moderator on the site
Hello, Giancarlo,

If the data in the column is same with a sheet name in the workbook, the sheet with the same name will be kept, other data will be split into separate sheet.
Thanks for your comment.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations