Колачићи нам помоћи да испоручи наше услуге. Коришћењем наше услуге, сагласни сте да наше коришћење колачића.
Савет: Други језици су Гоогле-преводили. Можете посетити English верзија ове везе.
лог ин
x
or
x
x
Регистровати
x

or

Како поделити податке у више радних листа на основу колоне у Екцелу?

Претпоставимо да имате радни лист са огромним редовима података, а сада морате подијелити податке на више радних листова на основу име колона (погледајте следећи сцреенсхот), а имена се уносе случајно. Можда их прво можете сортирати, а затим их копирати и залепити један по један на друге нове радне листове. Али ово ће вам требати стрпљење да копирате и налепите више пута. Данас ћу причати о неким брзим триковима да бих решио овај задатак.

доц подели податке по колонама КСНУМКС

Раздвојите податке у више радних листа на основу колоне са ВБА кодом

Раздвојите податке у више радних листова на основу колоне са Кутоолс за Екцел


Раздвојите податке у више радних листова на основу одређеног броја колона или редова на радном листу:

Ако желите да поделите велики радни лист у више листова на основу одређених података колоне или броја редова, Кутоолс за Екцел's Сплит Подаци функција вам може помоћи да решите овај задатак брзо и једноставно.

доц подели податке по колонама КСНУМКС

Кутоолс за Екцел: са више КСНУМКС практичних додатака за Екцел, слободно покушати без ограничења у КСНУМКС данима. Преузмите и пробајте сада!


Раздвојите податке у више радних листа на основу колоне са ВБА кодом


Ако желите брзо и аутоматски поделити податке на основу вредности ступца, сљедећи ВБА код је добар избор. Урадите овако:

1. Држите га АЛТ + ФКСНУМКС тастере за отварање Мицрософт Висуал Басиц за апликације прозор.

2. Клик Убацити > Модули, и налепите следећи код у прозор Модуле.

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. Затим, притисните F5 да бисте покренули код, а оквир за промпт се појавио да би вас подсетио да изаберете ред заглавља, погледајте снимак екрана:

доц подели податке по колонама КСНУМКС

4. И онда кликните OK дугмета, ау другом пољу за потврду, изаберите податке о колони које желите да поделите на основу, погледајте снимак екрана:

доц подели податке по колонама КСНУМКС

5. Затим кликните OK, а сви подаци у активном радном листу су подељени на више радних листова по вредности колоне. Подељени радни листови су названи са именима подељених ћелија. Погледајте снимак екрана:

доц подели податке по колонама КСНУМКС

белешке: Распоредни радни листови се налазе на крају радне свеске у којој је главни радни лист.


Раздвојите податке у више радних листова на основу колоне са Кутоолс за Екцел

Као почетник Екцел-а, овај дугачак ВБА код је за нас нешто тешко, а већина нас чак и не зна како да модификује код као нашу потребу.

Овде ћу вам представити мултифункционалну алатку--Кутоолс за Екцел, његово Сплит Подаци корисност не само да вам може помоћи да подијелите податке у више радних листова на основу колоне, већ можете подијелити податке по бројевима редова.

Кутоолс за Екцел : са више од КСНУМКС практичних додатака за Екцел, слободно покушати без ограничења у КСНУМКС данима.

Ако сте инсталирали Кутоолс за Екцел, молимо вас да урадите на следећи начин:

1. Изаберите распон података које желите поделити.

2. Клик Кутоолс Плус > Радни лист > Сплит Подаци, погледајте сцреенсхот:

доц подели податке по колонама КСНУМКС

3. у Раздвојите податке у више радних листова дијалог бок, морате:

КСНУМКС). Изаберите Специфични ступац опција у Сплит на основу одељак и изаберите вредност ступца на коју желите да поделите податке на основу падајуће листе. (Ако ваши подаци имају заглавља и желите их уметнути у сваки нови радни лист, пратите их Моји подаци имају заглавља опција.)

КСНУМКС). Затим можете одредити имена подијељених таблица, испод Нови радни листови одељак, наведите правила имена са листе Правила спустите листу, можете додати префикс or суфикс за имена листова.

КСНУМКС). Кликните OK дугме. Погледајте снимак екрана:

доц подели податке по колонама КСНУМКС

4. Сада су подаци подијељени на више радних листова у новој радној свесци.

доц подели податке по колонама КСНУМКС

Кликните да бисте преузели Кутоолс за Екцел и бесплатни пробни сад!


Раздвојите податке у више радних листова на основу колоне са Кутоолс за Екцел

Кутоолс за Екцел укључује више од КСНУМКС практичних Екцел алата. Слободно покушати без ограничења у КСНУМКС данима. Преузмите бесплатну пробну верзију одмах!


Повезани чланак:

Како поделити податке у више радних листова по броју редова?



Препоручени алати за продуктивност

Оффице Таб

златна звездаКСНУМКС Дајте практичне картице у Екцел и други Оффице програм, баш као и Цхроме, Фирефок и нови Интернет Екплорер.

Кутоолс за Екцел

златна звездаКСНУМКС Невероватно! Повећајте продуктивност у КСНУМКС минуту. Не требају никакве посебне вјештине, осим два сата сваког дана!

златна звездаКСНУМКС КСНУМКС Нове функције за Екцел, учините Екцел пуно једноставно и моћно:

  • Споји ћелије / редове / колоне без губитка података.
  • Комбинујте и консолидујте више листова и радне свеске.
  • Упоредите опсеге, копирајте више опсега, претворите текст на датум, јединицу и конверзију валута.
  • Цоунт би Цолорс, Пагинг Субтоталс, Адванцед Сорт и Супер Филтер,
  • Више Изабери / Уметни / Обриши / Текст / Формат / Линк / Коментар / Радна свеска / Радни листови Алати ...

Сцреен схот оф Кутоолс за Екцел

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.
    Alex S · 3 months ago
    To anyone having issues with long sheet names (ie Sheet Names greater than 30 characters), replace:

    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

    with

    Dim sheetName As String
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    ' Replace the below assignment to sheetName as you wish
    sheetName = Left(CStr(i - 1) & "_" & myarr(i), 30)
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = sheetName
    Else
    Sheets(sheetName).Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(sheetName).Range("A1")
    Sheets(sheetName).Columns.AutoFit
    Next

    This essentially limits the Sheet Name to legal limits of 30 characters. If you do not like the way the sheet is named, replace sheetName's assignment whatever you would like, keeping in mind that no two sheets can have the exact same name and must also be 30 characters or less.

    You can also remove the filtering that lingers at the end of the execution by adding this line just before "End Sub"

    On Error Resume Next
    ActiveSheet.ShowAllData

    Enjoy ^_^
  • To post as a guest, your comment is unpublished.
    pradeep sharma · 4 months ago
    I have used this VBA code, its split the data but split whole data in new sheet instead of unique value.
  • To post as a guest, your comment is unpublished.
    Pradeep Sharma · 4 months ago
    The VBA code split the data perfectly but its split the whole data instead of unique value.
  • To post as a guest, your comment is unpublished.
    Jorge Portillo · 4 months ago
    The codes works perfectly, only trouble is that it does not separate columns when the text is too long, I have text with 40 characters and I get an empty "sheet2", every other text gets sorted.


    Any ideas on how to fix it? I've already tried changin variable and placed them as Long, however I am not sure I fully understand the program. all this for the VBA option.
  • To post as a guest, your comment is unpublished.
    Manish · 5 months ago
    I need a macro for following condition
    suppose i have customer excel file in which first 7 rows is for header so, from 8th row records are start
    i need to split rows of 500 record each in one file and save them with name customer1,customer2,customer3,........
    suppose i have customer file of 2540 records so it split in
    customer1 which have header rows with record starts from 8th row to 507th row
    customer2 which have header rows with record starts from 508th row to 1007th row
    customer3 which have header rows with record starts from 1008th row to 1507th row
    customer4 which have header rows with record starts from 1508th row to 2007th row
    customer5 which have header rows with record starts from 2008th row to 2507th row
    customer6 which have header rows with record starts from 2508th row to 2540th row
    • To post as a guest, your comment is unpublished.
      parabola hiperbola · 13 days ago
      hi. I have similar situation, I want to keep first 8 rows in every sheet created. did you find any solution to this?
      • To post as a guest, your comment is unpublished.
        skyyang · 4 days ago
        Hi, guys,
        If your worksheet data contains multiple header rows, the below VBA code can solve your prolem, please try it.

        Sub Parse_data_0213()
        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

        Hope it can help you, thank you!