Gå til hovedindhold

Excel-tip: Opdel data i flere regneark/projektmapper baseret på kolonneværdi

Når du administrerer store datasæt i Excel, kan det være yderst fordelagtigt at opdele data i flere regneark baseret på specifikke kolonneværdier. Denne metode forbedrer ikke kun organiseringen af ​​data, men forbedrer også læsbarheden og letter dataanalysen.

Antag, at du har en stor salgsrekord, der indeholder flere poster, såsom produktnavnet, den solgte mængde i første kvartal. Målet er at opdele disse data i separate arbejdsark baseret på hvert produktnavn, så individuelle salgsresultater kan analyseres separat.

Opdel data i flere regneark baseret på kolonneværdi

Opdel data i flere projektmapper baseret på kolonneværdi med VBA-kode


Opdel data i flere regneark baseret på kolonneværdi

Normalt kan du først sortere datalisten og derefter kopiere og indsætte dem én efter én i andre nye regneark. Men dette kræver din tålmodighed til at kopiere og indsætte gentagne gange. I dette afsnit introducerer vi to enkle metoder til effektivt at tackle denne opgave i Excel, hvilket sparer dig tid og reducerer risikoen for fejl.

Opdel data i flere regneark baseret på kolonneværdi med VBA-kode

1. Hold nede i ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. klik indsatte > Moduler, og indsæt følgende kode i modulvinduet.

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. Tryk derefter på F5 tasten for at køre koden, og en promptboks vises for at minde dig om at vælge overskriftsrækken, og klik derefter på OK. Se skærmbillede:

4. I den anden promptboks skal du vælge de kolonnedata, som du vil opdele baseret på, og derefter klikke OK. Se skærmbillede:

5. Alle data i det aktive regneark er opdelt i flere regneark baseret på kolonneværdierne. De resulterende regneark navngives efter værdierne i de opdelte celler og placeres i slutningen af ​​projektmappen. Se skærmbillede:

 

Opdel data i flere regneark baseret på kolonneværdi med Kutools til Excel

Kutools til Excel bringer smart funktion - Opdel data direkte ind i dit Excel-miljø. At opdele data i flere regneark er ikke længere en udfordring. Vores intuitive værktøj opdeler automatisk dit datasæt baseret på den valgte kolonneværdi eller antal rækker, hvilket sikrer, at hver enkelt information er præcis, hvor du har brug for den. Sig farvel til den kedelige opgave at manuelt organisere dine regneark og omfavn en hurtigere, fejlfri måde at administrere dine data på.

Bemærk: At anvende dette Opdel dataFor det første skal du downloade Kutools til Excel, og anvend derefter funktionen hurtigt og nemt.

Efter installation Kutools til Excel, vælg dataområdet, og klik derefter på Kutools Plus > Opdel data at åbne Opdel data i flere regneark dialog boks.

  1. Type Specifik kolonne valgmulighed i Split baseret på sektion, og vælg den kolonneværdi, som du vil opdele dataene baseret på, fra rullelisten.
  2. Hvis dine data har overskrifter, og du ønsker at indsætte dem i hvert nyt opdelt regneark, så tjek venligst Mine data har overskrifter mulighed. (Du kan angive antallet af overskriftsrækker baseret på dine data. Hvis dine data f.eks. indeholder to overskrifter, skal du indtaste 2.)
  3. Derefter kan du angive navnene på delt regneark under Nyt regnearknavn sektion, skal du angive reglen for regnearknavne fra rullelisten Regler, kan du tilføje Præfiks or Suffiks også for arknavne.
  4. Klik på knappen OK knap. Se skærmbillede:

Nu er dataene i regnearket opdelt i flere regneark i en ny projektmappe.


Opdel data i flere projektmapper baseret på kolonneværdi med VBA-kode

Lejlighedsvis, i stedet for at opdele data i flere regneark, kan det være mere fordelagtigt at opdele dataene i separate projektmapper baseret på en nøglekolonne. Her er en trin-for-trin guide til, hvordan du bruger VBA-kode til at automatisere processen med at opdele data i flere projektmapper baseret på en specifik kolonneværdi.

1. Hold nede i ALT + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

2. klik indsatte > Moduler, og indsæt følgende kode i Modul vindue.

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    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.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub
Bemærk: I ovenstående kode skal du ændre filstien til din egen, hvor du vil gemme de opdelte projektmapper i dette script: savePath = "C:\Users\AddinsVM001\Desktop\flere filer\".

3. Tryk derefter på F5 tasten for at køre koden, og en promptboks vises for at minde dig om at vælge overskriftsrækken, og klik derefter på OK. Se skærmbillede:

4. I den anden promptboks skal du vælge de kolonnedata, som du vil opdele baseret på, og derefter klikke OK. Se skærmbillede:

5. Efter opdeling er alle data i det aktive regneark opdelt i flere projektmapper baseret på kolonneværdierne. Alle de opdelte projektmapper gemmes i den mappe, du har angivet. Se skærmbillede:

Relaterede artikler:

  • Opdel data i flere regneark efter antal rækker
  • Effektiv opdeling af et stort dataområde i flere Excel-regneark baseret på et bestemt rækkeantal kan strømline datastyring. For eksempel kan opdeling af et datasæt hver 5. række i flere ark gøre det mere overskueligt og organiseret. Denne vejledning tilbyder to praktiske metoder til at udføre denne opgave hurtigt og nemt.
  • Flet to eller flere tabeller til én baseret på nøglekolonner
  • Antag, at du har tre tabeller i en projektmappe, nu vil du flette disse tabeller i en tabel baseret på de tilsvarende nøglekolonner for at få resultatet som vist nedenstående skærmbillede. Dette kan være en besværlig opgave for de fleste af os, men bare rolig, denne artikel, jeg vil introducere nogle metoder til løsning af dette problem.
  • Opdel tekststrenge med skilletegn i flere rækker
  • Normalt kan du bruge funktionen Tekst til kolonne til at opdele celleindhold i flere kolonner med et specifikt skilletegn, såsom komma, prik, semikolon, skråstreg osv. Men nogle gange kan det være nødvendigt at opdele det afgrænsede celleindhold i flere rækker og gentag dataene fra andre kolonner som vist nedenfor. Har du nogen gode måder at håndtere denne opgave i Excel? Denne tutorial vil introducere nogle effektive metoder til at fuldføre dette job i Excel.
  • Opdel multiline celleindhold i adskilte rækker/kolonner
  • Hvis du antager, at du har celleindhold med flere linjer, som er adskilt af Alt + Enter, og nu skal du opdele multilinjeindholdet i adskilte rækker eller kolonner, hvad kan du gøre? I denne artikel vil du lære, hvordan du hurtigt opdeler celleindhold med flere linjer i adskilte rækker eller kolonner.

Bedste kontorproduktivitetsværktøjer

🤖 Kutools AI Aide: Revolutionér dataanalyse baseret på: Intelligent udførelse   |  Generer kode  |  Opret brugerdefinerede formler  |  Analyser data og generer diagrammer  |  Aktiver Kutools funktioner...
Populære funktioner: Find, fremhæv eller identificer dubletter   |  Slet tomme rækker   |  Kombiner kolonner eller celler uden at miste data   |   Runde uden formel ...
Super opslag: VLookup med flere kriterier    Multiple Value VLookup  |   VOpslag på tværs af flere ark   |   Fuzzy Lookup ....
Avanceret rulleliste: Opret hurtigt rulleliste   |  Afhængig rulleliste   |  Multivælg rulleliste ....
Column Manager: Tilføj et bestemt antal kolonner  |  Flyt kolonner  |  Skift synlighedsstatus for skjulte kolonner  |  Sammenlign områder og kolonner ...
Fremhævede funktioner: Grid fokus   |  Designvisning   |   Stor Formel Bar    Arbejdsbog & Ark Manager   |  Ressourcebibliotek (Autotekst)   |  Datovælger   |  Kombiner regneark   |  Krypter/Dekrypter celler    Send e-mails efter liste   |  Superfilter   |   Specielt filter (filter fed/kursiv/gennemstreget...) ...
Top 15 værktøjssæt12 tekst Værktøjer (tilføje tekst, Fjern tegn, ...)   |   50 + Chart Typer (Gantt kort, ...)   |   40+ Praktisk formler (Beregn alder baseret på fødselsdag, ...)   |   19 Indsættelse Værktøjer (Indsæt QR-kode, Indsæt billede fra sti, ...)   |   12 Konvertering Værktøjer (Tal til ord, Valutaomregning, ...)   |   7 Flet og del Værktøjer (Avancerede kombinere rækker, Opdel celler, ...)   |   ... og mere

Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid.  Klik her for at få den funktion, du har mest brug for...

Beskrivelse


Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
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