Введение

Итак, предположим, у нас есть лист с большим количеством данных и нам необходимо разделить данные на несколько рабочих листов на основе столбца «Категория». Выполнить эту задачу можно вручную, используя инструмент сортировки данных, но в этом случае потребуется Ваше терпение для повторного копирования данных.

Готовые коды для разделения таблиц на листы.

Прежде чем копировать код, посмотрите видеоролик о том, как это работает. Приятного просмотра!

456239038 x6-p_lwsJaY 9e800ff91f3ed320b95d21fbd681d216 vtNhROOS8KhU

Готовый скрипт разделения Google таблиц на листы:

function myFunction1() {
    //Сортируем диапазон от А до Я (столбец для разделения должен быть первым!)
    var spreadsheet = SpreadsheetApp.getActive();
    spreadsheet.getRange('A2').activate();
    var currentCell = spreadsheet.getCurrentCell();
    spreadsheet.getSelection().getNextDataRange(SpreadsheetApp.Direction.DOWN).activate();
    currentCell.activateAsCurrentCell();
    currentCell = spreadsheet.getCurrentCell();
    spreadsheet.getSelection().getNextDataRange(SpreadsheetApp.Direction.NEXT).activate();
    currentCell.activateAsCurrentCell().sort({column: 1, ascending: true});

    //Создаем новый лист "Уник"
    spreadsheet.insertSheet(2);
    spreadsheet.getActiveSheet().setName('Уник');

    //Копируем данные на лист "Уник"
    spreadsheet.setActiveSheet(spreadsheet.getSheetByName('Данные'), true);
    spreadsheet.setActiveSheet(spreadsheet.getSheetByName('Уник'), true);
    spreadsheet.getRange('\'Данные\'!A:A').copyTo(spreadsheet.getActiveRange(), SpreadsheetApp.CopyPasteType.PASTE_NORMAL, false);

    //Удаляем дубли + считаем число значений
    spreadsheet.getRange('A:A').removeDuplicates().activate();
    spreadsheet.getRange('B1').setFormula("=COUNTA(A:A)");

    var unique = spreadsheet.getRange('\'Уник\'!B1').getValue(); //Получаем число уникальных строк

    var data = spreadsheet.getRange('A1:A'+unique).getValues(); //Получаем список уникальных имен

    for (var i = 0; i < data.length; i++) {
        var tabName = data[i];
        spreadsheet.insertSheet(tabName.toString());
        spreadsheet.getCurrentCell().setFormula('FILTER(Данные!A1:Z1000; Данные!A1:A1000="'+data[i]+'")');
    }
};

Готовый код Excel VBA для разделения на листы:

Sub Splitdata()
'Разбитие данных на несколько листов на основе столбца в Excel'
    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("Выберите строки с заголовками:", "Excel", "", Type:=8)
    If TypeName(xTRg) = "Nothing" Then Exit Sub
    Set xVRg = Application.InputBox("Выберите столбец, по которому Вы хотите разделить данные:", "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

Заключение

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

У нас Вы можете заказать выполнение задач по MS Excel и Google таблицам

А также, пройти бесплатные онлайн курсы по MS Excel с заданиями