Mae cwcis yn ein helpu i gyflwyno ein gwasanaethau. Drwy ddefnyddio ein gwasanaethau, rydych yn cytuno i'n defnydd cwcis.
Tip: Mae ieithoedd eraill yn Google-Cyfieithu. Gallwch ymweld â'r English fersiwn o'r ddolen hon.
Mewngofnodi
x
or
x
x
cofrestr
x

or

Sut i rannu data mewn taflenni gwaith lluosog yn seiliedig ar golofn yn Excel?

Gan dybio bod gennych daflen waith gyda rhesi enfawr o ddata, a nawr, mae angen i chi rannu'r data yn nifer o daflenni gwaith yn seiliedig ar y enw colofn (gweler y sgrin ganlynol), ac mae'r enwau yn cael eu cofnodi ar hap. Efallai y gallwch chi eu datrys yn gyntaf, ac wedyn eu copïo a'u gludio un i un i mewn i daflenni gwaith newydd eraill. Ond bydd angen amynedd arnoch i gopïo a gludo dro ar ôl tro. Heddiw, siaradaf am rai driciau cyflym i ddatrys y dasg hon.

Dosbarthwyd data doc gan y colofnau 1

Rhannwch ddata i daflenni gwaith lluosog yn seiliedig ar golofn gyda chod VBA

Rhannwch ddata mewn taflenni gwaith lluosog yn seiliedig ar golofn gyda Kutools ar gyfer Excel


Rhannwch ddata i mewn i daflenni gwaith lluosog yn seiliedig ar golofn neu rhesi penodol yn cyfrif yn y daflen waith:

Os ydych chi eisiau rhannu taflen waith fawr i mewn i lawer o daflenni ar sail data colofn penodol neu gyfrif rhesi, y Kutools ar gyfer Excel's Rhannu Data Gall nodwedd eich helpu i ddatrys y dasg hon yn gyflym ac yn hawdd.

Dosbarthwyd data doc gan y colofnau 6

Kutools ar gyfer Excel: gyda mwy na 200 Excel add-ins, yn rhad ac am ddim i geisio heb gyfyngiad mewn dyddiau 60. Lawrlwythwch a threial am ddim Nawr!


Rhannwch ddata i daflenni gwaith lluosog yn seiliedig ar golofn gyda chod VBA


Os ydych chi eisiau rhannu'r data yn seiliedig ar werth y golofn yn gyflym ac yn awtomatig, mae'r cod VBA canlynol yn ddewis da. Gwnewch fel hyn:

1. Dal i lawr 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()
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. Yna, pwyswch F5 allwedd i redeg y cod, ac mae blwch prydlon wedi'i datgelu i'ch atgoffa yn dewis y rhes pennawd, gweler y sgrin:

Dosbarthwyd data doc gan y colofnau 7

4. Ac yna, cliciwch OK botwm, ac yn yr ail blwch prydlon, dewiswch y data colofn yr ydych am ei rannu yn seiliedig ar, gweler y sgrin:

Dosbarthwyd data doc gan y colofnau 8

5. Yna, cliciwch OK, ac mae'r holl ddata yn y daflen waith weithredol wedi'i rhannu'n sawl taflen waith gan werth y golofn. Ac mae'r taflenni gwaith rhanedig wedi'u henwi gyda'r enwau celloedd rhannol. Gweler y sgrin:

Dosbarthwyd data doc gan y colofnau 2

Nodyn: Rhoddir y taflenni gwaith ar ddiwedd y llyfr gwaith lle mae'r daflen waith feistr.


Rhannwch ddata mewn taflenni gwaith lluosog yn seiliedig ar golofn gyda Kutools ar gyfer Excel

Fel dechreuwr Excel, mae'r cod VBA hir hwn braidd yn anodd i ni, ac nid yw'r rhan fwyaf ohonom hyd yn oed yn gwybod sut i addasu'r cod fel ein hangen.

Yma, byddaf yn cyflwyno offeryn amlswyddogaethol i chi -Kutools ar gyfer Excel, ei Rhannu Data gall cyfleustodau nid yn unig eich helpu chi i rannu data mewn taflenni gwaith lluosog yn seiliedig ar golofn, ond gall hefyd rannu data yn ôl cyfrifon rhesi.

Kutools ar gyfer Excel : gyda mwy na 300 Excel add-ins, yn rhad ac am ddim i geisio heb gyfyngiad mewn diwrnodau 60.

Os ydych chi wedi gosod Kutools ar gyfer Excel, gwnewch fel a ganlyn:

1. Dewiswch yr ystod o ddata rydych chi am ei rannu.

2. Cliciwch Kutools Mwy > Taflen waith > Rhannu Data, gweler y sgrin:

Dosbarthwyd data doc gan y colofnau 3

3. Yn y Rhannwch y Data i Daflenni Gwaith Lluosog blwch deialog, mae angen i chi:

1). Dewiswch Colofn benodol opsiwn yn y Rhannwch yn seiliedig ar , a dewiswch y gwerth golofn yr ydych am rannu'r data yn seiliedig ar y rhestr ostwng. (Os oes gan eich data benawdau a'ch bod am eu mewnosod i bob taflen waith newydd, gwiriwch Mae gan fy data benawdau opsiwn.)

2). Yna gallwch chi nodi enwau rhannau'r daflen waith, o dan y Enw taflenni gwaith newydd adran, nodwch reolau enwau'r daflen waith oddi wrth y Rheolau rhestr alw heibio, gallwch ychwanegu'r Rhagolwg or Ôl-ddodiad ar gyfer yr enwau taflenni hefyd.

3). Cliciwch y OK botwm. Gweler y sgrin:

Dosbarthwyd data doc gan y colofnau 4

4. Nawr mae'r data wedi'i rannu'n daflenni gwaith lluosog mewn llyfr gwaith newydd.

Dosbarthwyd data doc gan y colofnau 5

Cliciwch i Lawrlwythwch Kutools for Excel a threial am ddim Nawr!


Rhannwch ddata mewn taflenni gwaith lluosog yn seiliedig ar golofn gyda Kutools ar gyfer Excel

Kutools ar gyfer Excel yn cynnwys mwy na 300 offer llaw defnyddiol. Am ddim i geisio heb gyfyngiad mewn dyddiau 60. Lawrlwythwch y treial am ddim nawr!


Erthygl gysylltiedig:

Sut i rannu data i nifer o daflenni gwaith gan y rhesi yn cyfrif?



Offer Cynhyrchiant a Argymhellir

Tab Swyddfa

star1 aur Dewch â thafiau defnyddiol i Excel a meddalwedd Swyddfa eraill, yn union fel Chrome, Firefox a Internet Explorer newydd.

Kutools ar gyfer Excel

star1 aur Yn rhyfeddol! Cynyddu eich cynhyrchedd mewn munudau 5. Peidiwch ag angen unrhyw sgiliau arbennig, arbed dwy awr bob dydd!

star1 aur 300 Nodweddion Newydd ar gyfer Excel, Gwnewch Excel Yn Fach Hawdd a Phwerus:

  • Cyfuno Cell / Rows / Colofnau heb Colli Data.
  • Cyfuno a Chyfuno Taflenni Lluosog a Llyfrau Gwaith.
  • Cymharwch Rangau, Copi Lluosog, Trosi Testun hyd yma, Uned ac Addasu Arian.
  • Count by Colors, Subtotals Paging, Trefnu Uwch ac Uwch Hidlo,
  • Mwy Dethol / Mewnosod / Delete / Text / Format / Link / Comment / Llyfrau Gwaith / Taflenni Gwaith Offer ...

Sgrîn sgript o Kutools ar gyfer 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 · 3 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!