Skip i'r prif gynnwys

Cynghorion Excel: Rhannu data yn daflenni gwaith / llyfrau gwaith lluosog yn seiliedig ar werth colofn

Wrth reoli setiau data mawr yn Excel, gall fod yn fuddiol iawn rhannu data yn daflenni gwaith lluosog yn seiliedig ar werthoedd colofn penodol. Mae'r dull hwn nid yn unig yn gwella trefniadaeth data ond hefyd yn gwella darllenadwyedd ac yn hwyluso dadansoddi data yn haws.

Tybiwch fod gennych chi gofnod gwerthiant mawr sy'n cynnwys cofnodion lluosog fel enw'r cynnyrch, y swm a werthwyd yn y chwarter cyntaf. Y nod yw rhannu'r data hwn yn daflenni gwaith ar wahân yn seiliedig ar enw pob cynnyrch fel y gellir dadansoddi perfformiad gwerthiant unigol ar wahân.

Rhannu data yn daflenni gwaith lluosog yn seiliedig ar werth colofn

Rhannu data yn lyfrau gwaith lluosog yn seiliedig ar werth colofn gyda chod VBA


Rhannu data yn daflenni gwaith lluosog yn seiliedig ar werth colofn

Fel arfer, gallwch chi ddidoli'r rhestr ddata yn gyntaf, ac yna eu copïo a'u gludo fesul un i daflenni gwaith newydd eraill. Ond bydd hyn angen eich amynedd i gopïo a gludo dro ar ôl tro. Yn yr adran hon, byddwn yn cyflwyno dau ddull syml i fynd i'r afael â'r dasg hon yn effeithlon yn Excel, gan arbed amser i chi a lleihau'r posibilrwydd o gamgymeriadau.

Rhannu data yn daflenni gwaith lluosog yn seiliedig ar werth colofn gyda chod VBA

1. Daliwch y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Cliciwch Mewnosod > Modiwlau, a gludwch y cod canlynol yn y Ffenestr Modiwl.

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. Yna, pwyswch F5 allwedd i redeg y cod, ac mae blwch prydlon yn cael ei popio allan i'ch atgoffa i ddewis y rhes pennawd, ac yna, cliciwch OK. Gweler y screenshot:

4. Yn yr ail flwch prydlon, dewiswch y data colofn yr ydych am ei rannu yn seiliedig ar, yna, cliciwch OK. Gweler y screenshot:

5. Mae'r holl ddata yn y daflen waith weithredol wedi'i rannu'n daflenni gwaith lluosog yn seiliedig ar werthoedd y golofn. Mae'r taflenni gwaith canlyniadol yn cael eu henwi yn ôl y gwerthoedd yn y celloedd hollt ac yn cael eu gosod ar ddiwedd y llyfr gwaith. Gweler y sgrinlun:

 

Rhannwch ddata i mewn i daflenni gwaith lluosog yn seiliedig ar werth colofn gyda Kutools ar gyfer Excel

Kutools ar gyfer Excel yn dod â nodwedd smart - Data Hollti yn union i'ch amgylchedd Excel. Nid yw rhannu data yn daflenni gwaith lluosog yn her bellach. Mae ein hofferyn sythweledol yn rhannu'ch set ddata yn awtomatig yn seiliedig ar werth y golofn neu'r cyfrif rhesi a ddewiswyd, gan sicrhau bod pob darn o wybodaeth yn union lle mae ei angen arnoch. Ffarwelio â'r dasg ddiflas o drefnu'ch taenlenni â llaw a chofleidio ffordd gyflymach, ddi-wall o reoli'ch data.

Nodyn: I gymhwyso hyn Data Hollti, yn gyntaf, dylech lawrlwytho'r Kutools ar gyfer Excel, ac yna cymhwyswch y nodwedd yn gyflym ac yn hawdd.

Ar ôl gosod Kutools ar gyfer Excel, dewiswch yr ystod ddata, ac yna cliciwch Kutools Byd Gwaith > Data Hollti i agor y Rhannu Data yn daflenni gwaith lluosog blwch deialog.

  1. dewiswch Colofn benodol opsiwn yn y Hollti yn seiliedig ar adran, a dewiswch y gwerth colofn yr ydych am rannu'r data yn seiliedig arno o'r gwymplen.
  2. Os oes gan eich data benawdau a'ch bod am eu mewnosod ym mhob taflen waith hollt newydd, gwiriwch Mae penawdau yn fy data opsiwn. (Gallwch nodi nifer y rhesi pennyn yn seiliedig ar eich data. Er enghraifft, os yw eich data yn cynnwys dau bennawd, teipiwch 2.)
  3. Yna gallwch chi nodi'r enwau taflen waith rhanedig, o dan y Enw taflenni gwaith newydd adran, nodwch y rheol enwau taflen waith o'r gwymplen Rheolau, gallwch ychwanegu'r Rhagolwg or Ôl-ddodiad ar gyfer yr enwau dalen hefyd.
  4. Cliciwch ar y OK botwm. Gweler y screenshot:

Nawr, mae'r data yn y daflen waith wedi'i rannu'n daflenni gwaith lluosog mewn llyfr gwaith newydd.


Rhannu data yn lyfrau gwaith lluosog yn seiliedig ar werth colofn gyda chod VBA

O bryd i'w gilydd, yn hytrach na rhannu data yn daflenni gwaith lluosog, gall fod yn fwy buddiol rhannu'r data yn lyfrau gwaith ar wahân yn seiliedig ar golofn allweddol. Dyma ganllaw cam wrth gam ar sut i ddefnyddio cod VBA i awtomeiddio'r broses o rannu data yn lyfrau gwaith lluosog yn seiliedig ar werth colofn penodol.

1. Daliwch y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Cliciwch Mewnosod > Modiwlau, a gludwch y cod canlynol yn y Ffenestr Modiwl.

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
Nodyn: Yn y cod uchod, dylech newid y llwybr ffeil i'ch un chi lle bydd yn cadw'r llyfrau gwaith hollt yn y sgript hon: savePath = "C:\Users\AddinsVM001\Desktop\ffeiliau lluosog\".

3. Yna, pwyswch F5 allwedd i redeg y cod, ac mae blwch prydlon yn cael ei popio allan i'ch atgoffa i ddewis y rhes pennawd, ac yna, cliciwch OK. Gweler y screenshot:

4. Yn yr ail flwch prydlon, dewiswch y data colofn yr ydych am ei rannu yn seiliedig ar, yna, cliciwch OK. Gweler y screenshot:

5. Ar ôl hollti, mae'r holl ddata yn y daflen waith weithredol wedi'i rannu'n lyfrau gwaith lluosog yn seiliedig ar werthoedd y golofn. Mae'r holl lyfrau gwaith hollt yn cael eu cadw yn y ffolder a nodwyd gennych. Gweler y sgrinlun:

Erthyglau cysylltiedig:

  • Rhannwch ddata yn daflenni gwaith lluosog yn ôl rhesi cyfrif
  • Gall rhannu ystod ddata fawr yn effeithlon yn daflenni gwaith Excel lluosog yn seiliedig ar gyfrif rhes penodol symleiddio rheoli data. Er enghraifft, gall rhannu set ddata bob 5 rhes yn dudalennau lluosog ei gwneud yn fwy hylaw a threfnus. Mae'r canllaw hwn yn cynnig dau ddull ymarferol o gyflawni'r dasg hon yn gyflym ac yn hawdd.
  • Cyfuno dau dabl neu fwy yn un yn seiliedig ar golofnau allweddol
  • Gan dybio bod gennych dri thabl mewn llyfr gwaith, nawr, rydych chi am uno'r tablau hyn yn un tabl yn seiliedig ar y colofnau allweddol cyfatebol i gael y canlyniad fel y dangosir isod y screenshot. Efallai bod hon yn dasg drafferthus i'r mwyafrif ohonom, ond, peidiwch â phoeni, yr erthygl hon, byddaf yn cyflwyno rhai dulliau ar gyfer datrys y broblem hon.
  • Rhannwch Llinynnau Testun fesul Amffinydd yn Rhesi Lluosog
  • Fel arfer, gallwch ddefnyddio'r nodwedd Testun i Golofn i rannu cynnwys cell yn golofnau lluosog gan amffinydd penodol, megis coma, dot, hanner colon, slaes, ac ati. Ond, weithiau, efallai y bydd angen i chi rannu cynnwys y gell amffiniedig yn rhesi lluosog ac ailadrodd y data o golofnau eraill fel y sgrinlun a ddangosir isod. A oes gennych unrhyw ffyrdd da o ddelio â'r dasg hon yn Excel? Bydd y tiwtorial hwn yn cyflwyno rhai dulliau effeithiol i gwblhau'r swydd hon yn Excel.
  • Rhannu cynnwys celloedd aml-linell yn rhesi/colofnau wedi'u gwahanu
  • Gan dybio bod gennych gynnwys cell aml-linell sydd wedi'i wahanu gan Alt + Enter, a nawr bod angen i chi rannu'r cynnwys aml-linell i resi neu golofnau wedi'u gwahanu, beth allwch chi ei wneud? Yn yr erthygl hon, byddwch yn dysgu sut i rannu cynnwys celloedd aml-linell yn gyflym yn rhesi neu golofnau ar wahân.

Offer Cynhyrchiant Swyddfa Gorau

🤖 Kutools AI Aide: Chwyldro dadansoddi data yn seiliedig ar: Cyflawniad Deallus   |  Cynhyrchu Cod  |  Creu Fformiwlâu Personol  |  Dadansoddi Data a Chynhyrchu Siartiau  |  Invoke Swyddogaethau Kutools...
Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog    VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr    Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd    Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

Disgrifiad


Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
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