Cookies hjälper oss att leverera våra tjänster. Genom att använda våra tjänster samtycker du till vår användning av cookies.
Tips: Andra språk är Google-översatta. Du kan besöka English version av den här länken.
Logga in
x
or
x
x
Registrera
x

or

Hur delas data i flera kalkylblad baserat på kolumn i Excel?

Anta att du har ett kalkylblad med enorma rader med data, och nu måste du dela upp data i flera kalkylblad baserat på Namn kolumn (se följande skärmdump), och namnen skrivs in slumpmässigt. Kanske kan du sortera dem först och sedan kopiera och klistra in dem en efter en i andra nya kalkylblad. Men det här behöver ditt tålamod att kopiera och klistra in flera gånger. Idag ska jag prata om några snabba knep för att lösa denna uppgift.

doc delade data med kolumner 1

Dela data i flera arbetsblad baserat på kolumn med VBA-kod

Dela data i flera arbetsblad baserat på kolumn med Kutools for Excel


Dela data i flera kalkylblad baserat på specifik kolumn eller rader räkna i kalkylblad:

Om du vill dela ett stort kalkylblad i flera ark baserat på specifika kolumndata eller rader räknas Kutools för Excel's Split data funktionen kan hjälpa dig att lösa uppgiften snabbt och enkelt.

doc delade data med kolumner 6

Kutools för Excel: med mer än 200 praktiska Excel-tillägg, gratis att försöka utan begränsning i 60 dagar. Ladda ner och gratis test nu!


Dela data i flera arbetsblad baserat på kolumn med VBA-kod


Om du vill dela upp data baserat på kolumnvärde snabbt och automatiskt är följande VBA-kod ett bra val. Vänligen gör så här:

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka Infoga > Modulerna, och klistra in följande kod i modulfönstret.

Sub Splitdatabycol()
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
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
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").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. Tryck sedan på F5 nyckeln för att köra koden och en snabb ruta visas ut för att påminna dig om att välja rubrikrad, se skärmdump:

doc delade data med kolumner 7

4. Och sedan klickar du på OK knappen och i den andra snabbfältet, välj kolumndata som du vill dela ut baserat på, se skärmdump:

doc delade data med kolumner 8

5. Klicka sedan OK, och alla data i det aktiva kalkylbladet delas upp i flera kalkylblad med kolumnvärdet. Och delade kalkylblad heter med delade cellnamn. Se skärmdump:

doc delade data med kolumner 2

Anmärkningar: Uppdelade arbetsblad placeras i slutet av arbetsboken där masterkalkylbladet är i.


Dela data i flera arbetsblad baserat på kolumn med Kutools for Excel

Som en Excel-nybörjare är den här långa VBA-koden något svårt för oss, och de flesta av oss vet inte ens hur man ändrar koden som vårt behov.

Här kommer jag att presentera ett multifunktionellt verktyg -Kutools för Excel, dess Split data verktyget kan inte bara hjälpa dig att dela upp data i flera kalkylblad baserat på kolumnen, men kan också dela data med raderräkning.

Kutools för Excel : med mer än 300 praktiska Excel-tillägg, gratis att försöka utan begränsning i 60-dagar.

Om du har installerat Kutools för Excel, gör så här:

1. Välj det antal data som du vill dela upp.

2. Klicka Kutools More > Arbetsblad > Split data, se skärmdump:

doc delade data med kolumner 3

3. I Dela data till flera kalkylblad dialogrutan måste du:

1). Välj Specifik kolumn alternativet i Split baserat på avsnitt och välj det kolumnvärde som du vill dela upp data baserat på i listrutan. (Om dina data har rubriker och du vill infoga dem i varje nytt delat arbetsblad, kolla Mina data har rubriker alternativ.)

2). Då kan du ange delade kalkylarknamnen, under Nytt arbetsblad namn avsnittet, ange reglerna för regnearkets namn från regler listrutan, du kan lägga till Prefix or Ändelse för arknamnen också.

3). Klicka på OK knapp. Se skärmdump:

doc delade data med kolumner 4

4. Nu delas uppgifterna i flera arbetsblad i en ny arbetsbok.

doc delade data med kolumner 5

Klicka för att ladda ner Kutools för Excel och gratis test nu!


Dela data i flera arbetsblad baserat på kolumn med Kutools for Excel

Kutools för Excel innehåller mer än 300 praktiska Excel-verktyg. Gratis att försöka utan begränsning i 60 dagar. Ladda ner gratis försök nu!


Relaterad artikel:

Hur delas data i flera kalkylblad genom rader räkna?



Rekommenderade produktivitetsverktyg

Fliken Office

guld star1 Hämta praktiska flikar till Excel och annan Office-programvara, precis som Chrome, Firefox och ny Internet Explorer.

Kutools för Excel

guld star1 Fantastiskt! Öka din produktivitet i 5 minuter. Behöver inte några speciella färdigheter, spara två timmar varje dag!

guld star1 300 Nya funktioner för Excel, gör Excel mycket enkelt och kraftfullt:

  • Sammanfoga cell / rader / kolumner utan att förlora data.
  • Kombinera och konsolidera flera ark och arbetsböcker.
  • Jämför rader, kopiera flera rader, konvertera text till datum, enhet och valutaomvandling.
  • Räkna med färger, personsökande subtotaler, avancerad sortering och superfilter,
  • Mer Välj / Infoga / Radera / Text / Format / Länk / Kommentar / Arbetsböcker / Arbetsblad Verktyg ...

Skärmdump av Kutools för Excel

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Rudi Miller · 4 days ago
    Sub parse_data()
    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
    vcol = 1
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:C1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 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
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    Jason · 1 months ago
    This formula is great, works perfectly for me.
    I want to split out data based on a location, which is in column 1. Which this does.
    However, is it possible to also split out based on column 2, for example. Built and Not Built. So a secondary condition also?
  • To post as a guest, your comment is unpublished.
    jose · 1 months ago
    can someone help please im using this but i keep getting to many columns. i have to keep deleting rows every time i use this.

    This is what im using


    Sub parse_data()
    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
    vcol = 1
    Set ws = Sheets("sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:AN1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 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
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    avinash · 1 months ago
    Thanks for VBA, it works great. In addition to that question, I have column which is dependent. So when i select some value my column values get changed hence I need vba solution to replace earlier split worksheet to replace with new value of columns. Can anyone help me out.?

    Thanks in advance
  • To post as a guest, your comment is unpublished.
    JP Tontegode · 1 months ago
    Is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!