Печенье помочь нам доставить наши услуги. Пользуясь нашими услугами, Вы соглашаетесь на использование нами куки.
Совет. Другие языки - Google-Translated. Вы можете посетить English версия этой ссылки.
Вход
x
or
x
x
Регистрация
x

or

Как разбить данные на несколько рабочих листов на основе столбца в Excel?

Предположим, что у вас есть рабочий лист с огромными рядами данных, и теперь вам нужно разбить данные на несколько рабочих листов на основе Имя (см. следующий скриншот), и имена вводятся случайным образом. Возможно, вы можете отсортировать их сначала, а затем скопировать и вставить их один за другим в другие новые рабочие листы. Но это потребует вашего терпения, чтобы копировать и вставлять многократно. Сегодня я расскажу о некоторых быстрых трюках для решения этой задачи.

doc разделяет данные по столбцам 1

Разделить данные на несколько листов на основе столбца с кодом VBA

Разделить данные на несколько рабочих листов на основе столбца с помощью Kutools for Excel


Разделить данные на несколько рабочих листов на основе определенных столбцов или строк, отсчитываемых на листе:

Если вы хотите разбить большой рабочий лист на несколько листов на основе определенных данных столбцов или строк, Kutools for Excel's Разделить данные функция поможет вам быстро и легко решить эту задачу.

doc разделяет данные по столбцам 6

Kutools for Excel: с более чем 200 удобными надстройками Excel, бесплатно попробовать без ограничений в 60-дни. Скачать и бесплатно пробную версию!


Разделить данные на несколько листов на основе столбца с кодом VBA


Если вы хотите быстро и автоматически разбить данные на основе значения столбца, следующий код VBA является хорошим выбором. Пожалуйста, сделайте следующее:

1, Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окна.

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 ключ для запуска кода, и появится окно с предложением напомнить вам о выборе строки заголовка, см. скриншот:

doc разделяет данные по столбцам 7

4, Затем нажмите OK и во втором окне запроса выберите данные столбца, на которые вы хотите разделить данные, см. снимок экрана:

doc разделяет данные по столбцам 8

5, Затем нажмите OKи все данные в активном листе делятся на несколько листов по значению столбца. И разделенные рабочие листы имеют имена с разделенными ячейками. Смотрите скриншот:

doc разделяет данные по столбцам 2

Внимание: Таблицы расщепления помещаются в конец рабочей книги, где находится основной рабочий лист.


Разделить данные на несколько рабочих листов на основе столбца с помощью Kutools for Excel

Как начинающий Excel, этот длинный код VBA нам довольно сложно, и большинство из нас даже не знает, как изменить код как нашу потребность.

Здесь я расскажу вам о многофункциональном инструменте -Kutools for Excel, Его Разделить данные Утилита не только поможет вам разделить данные на несколько листов на основе столбца, но также может разбивать данные по количеству строк.

Kutools for Excel : с более чем 300 удобными надстройками Excel, бесплатно попробовать без ограничений в 60-дни.

Если вы установили Kutools for Excel, сделайте следующее:

1, Выберите диапазон данных, которые вы хотите разбить.

2. Щелчок Kutools Plus > Рабочий лист > Разделить данные, см. снимок экрана:

doc разделяет данные по столбцам 3

3. В Разделить данные на несколько рабочих листов диалогового окна, вам необходимо:

1). Выбрать Конкретная колонка вариант в Разделить на основе и выберите значение столбца, которое вы хотите разделить на основе данных в раскрывающемся списке. (Если у ваших данных есть заголовки, и вы хотите вставить их в каждый новый рабочий лист, пожалуйста, проверьте У моих данных есть заголовки опция).

2). Затем вы можете указать имена разделенных таблиц, под Название новых рабочих листов раздел, укажите правила имен рабочих листов из Правила вы можете добавить Префикс or Суффикс для имен листов.

3). Нажмите OK кнопка. Смотрите скриншот:

doc разделяет данные по столбцам 4

4, Теперь данные разделены на несколько рабочих листов в новой книге.

doc разделяет данные по столбцам 5

Нажмите, чтобы загрузить Kutools for Excel и бесплатную пробную версию.


Разделить данные на несколько рабочих листов на основе столбца с помощью Kutools for Excel

Kutools for Excel включает в себя более удобные инструменты Excel 300. Бесплатно, без ограничений, в 60-дни. Скачайте бесплатную пробную версию прямо сейчас!


Связанная статья:

Как разбить данные на несколько листов по количеству строк?



Рекомендуемые инструменты производительности

Office Tab

золото star1 Принесите удобные вкладки в Excel и другое программное обеспечение Office, как Chrome, Firefox и новый Internet Explorer.

Kutools for Excel

золото star1 Удивительно! Увеличьте производительность в течение 5 минут. Не нужно никаких специальных навыков, сэкономить два часа каждый день!

золото star1 Новые возможности 300 для Excel, сделать Excel намного проще и мощнее:

  • Объединить ячейки / строки / столбцы без потери данных.
  • Объединение и объединение нескольких листов и книг.
  • Сравнение диапазонов, копирование нескольких диапазонов, преобразование текста в дату, преобразование единиц и валют.
  • Подсчет количества цветов, Пейджинговые субтитры, Расширенный сортировка и Суперфильтр,
  • Подробнее Выбрать / Вставить / Удалить / Текст / Формат / Ссылка / Комментарий / Рабочие книги / Рабочие листы Инструменты ...

Снимок экрана Kutools для 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 · 1 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!