Option Explicit ' ===== moduleSplitByManager · сделано в AXEL 01.10.2026 =====' Разносит строки листа «Продажи» по менеджерам (столбец B):' каждому — свой лист в этой книге и свой файл .xlsx' в подпапке «По менеджерам» рядом с книгой.' Исходный лист только читается. Удаляются только листы,' созданные этим макросом (у них есть скрытая метка). Private Const SRC_SHEET As String = "Продажи"         ' лист с даннымиPrivate Const KEY_COL As Long = 2                     ' B = «Менеджер»Private Const OUT_FOLDER As String = "По менеджерам"  ' подпапка для файловPrivate Const TAG As String = "AXEL_split"            ' метка наших листов Public Sub SplitByManager()    Dim src As Worksheet, ws As Worksheet    Dim data As Variant, part() As Variant    Dim managers As New Collection, m As Variant    Dim lastRow As Long, lastCol As Long, skipped As Long    Dim r As Long, c As Long, k As Long    Dim folder As String, msg As String    Dim icon As VbMsgBoxStyle, calcMode As XlCalculation     ' --- 1. Проверки: книга сохранена на диске, лист и данные есть ---    If Len(ThisWorkbook.Path) = 0 Or Left$(ThisWorkbook.Path, 4) = "http" Then        MsgBox "Сохраните книгу в папку на диске: файлы появятся рядом с ней.", vbExclamation        Exit Sub    End If    If Not SheetExists(SRC_SHEET) Then        MsgBox "Не найден лист «" & SRC_SHEET & "».", vbExclamation        Exit Sub    End If    Set src = ThisWorkbook.Worksheets(SRC_SHEET)    lastRow = src.Cells(src.Rows.Count, KEY_COL).End(xlUp).Row    lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column    If lastRow < 2 Then        MsgBox "На листе «" & SRC_SHEET & "» нет строк с данными.", vbInformation        Exit Sub    End If     ' --- 2. Ускоряем работу; настройки вернём в блоке Finish ---    calcMode = Application.Calculation    On Error GoTo Fail    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Application.Calculation = xlCalculationManual     ' --- 3. Убираем листы прошлого запуска (только с меткой TAG) ---    DeleteOwnSheets     ' --- 4. Список менеджеров без повторов (регистр не важен) ---    data = src.Range(src.Cells(1, 1), src.Cells(lastRow, lastCol)).Value    For r = 2 To lastRow        m = KeyOf(data(r, KEY_COL))        If Len(m) = 0 Then            skipped = skipped + 1                 ' строка без менеджера        ElseIf Not HasKey(managers, CStr(m)) Then            managers.Add m, m        End If    Next r     ' --- 5. Подпапка рядом с книгой ---    folder = ThisWorkbook.Path & Application.PathSeparator & OUT_FOLDER    If Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder     ' --- 6. Каждому менеджеру: свой лист и свой файл ---    For Each m In managers        ReDim part(1 To lastRow, 1 To lastCol)        k = 0        For r = 1 To lastRow                      ' строка 1 — шапка            If r = 1 Or StrComp(KeyOf(data(r, KEY_COL)), m, vbTextCompare) = 0 Then                k = k + 1                For c = 1 To lastCol                    part(k, c) = data(r, c)                Next c            End If        Next r         Set ws = ThisWorkbook.Worksheets.Add( _            After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))        ws.Name = FreeSheetName(CStr(m))        ws.CustomProperties.Add Name:=TAG, Value:="1"        For c = 1 To lastCol                      ' форматы дат и сумм — как в исходнике            ws.Columns(c).NumberFormat = src.Cells(2, c).NumberFormat        Next c        ws.Range("A1").Resize(k, lastCol).Value = part   ' значения, без формул        ws.Rows(1).Font.Bold = True        ws.Range("A1").Resize(k, lastCol).Columns.AutoFit         ws.Copy                                   ' копия листа = новая книга        With ActiveWorkbook            .SaveAs Filename:=folder & Application.PathSeparator & _                Clean(CStr(m)) & ".xlsx", FileFormat:=xlOpenXMLWorkbook            .Close SaveChanges:=False        End With    Next m     src.Activate    msg = "Готово: листов и файлов — " & managers.Count & vbCrLf & _          "Папка: " & folder & vbCrLf & _          "Пропущено строк без менеджера: " & skipped    icon = vbInformation Finish:    ' --- 7. Возвращаем настройки Excel в любом случае ---    Application.Calculation = calcMode    Application.DisplayAlerts = True    Application.ScreenUpdating = True    If Len(msg) > 0 Then MsgBox msg, icon, "AXEL: разнести по менеджерам"    Exit Sub Fail:    msg = "Макрос остановлен: " & Err.Description & vbCrLf & _          "Лист «" & SRC_SHEET & "» не изменён."    icon = vbCritical    Resume FinishEnd Sub ' Удаляет только листы с меткой TAG — созданные прошлым запускомPrivate Sub DeleteOwnSheets()    Dim i As Long, p As Long, ws As Worksheet    For i = ThisWorkbook.Worksheets.Count To 1 Step -1        Set ws = ThisWorkbook.Worksheets(i)        For p = 1 To ws.CustomProperties.Count            If ws.CustomProperties(p).Name = TAG Then                ws.Delete                Exit For            End If        Next p    Next iEnd Sub ' Текст ячейки без пробелов по краям; ошибки (#Н/Д) и пустые -> ""Private Function KeyOf(ByVal v As Variant) As String    If Not IsError(v) Then KeyOf = Trim$(CStr(v))End Function ' Есть ли ключ в коллекции (сравнение без учёта регистра)Private Function HasKey(col As Collection, ByVal key As String) As Boolean    Dim v As Variant    On Error Resume Next    v = col(key)    HasKey = (Err.Number = 0)    On Error GoTo 0End Function ' Есть ли в книге лист с таким именемPrivate Function SheetExists(ByVal sName As String) As Boolean    Dim sh As Object    For Each sh In ThisWorkbook.Sheets        If StrComp(sh.Name, sName, vbTextCompare) = 0 Then            SheetExists = True            Exit Function        End If    Next shEnd Function ' Заменяет символы, запрещённые в именах листов и файловPrivate Function Clean(ByVal s As String) As String    Dim ch As Variant    For Each ch In Array("\", "/", ":", "*", "?", """", "<", ">", "|", "[", "]")        s = Replace(s, ch, "_")    Next ch    Clean = sEnd Function ' Свободное имя листа: до 31 знака и не совпадает с чужими листамиPrivate Function FreeSheetName(ByVal s As String) As String    Dim base As String, nm As String, n As Long    base = Left$(Clean(s), 25)    nm = base    n = 1    Do While SheetExists(nm)        n = n + 1        nm = base & " (" & n & ")"    Loop    FreeSheetName = nmEnd Function

REM ===== moduleSplitByManager для LibreOffice Calc · AXEL 01.10.2026 =====REM Разносит строки листа «Продажи» по менеджерам (столбец B):REM свой лист в книге и свой файл .xlsx в подпапке рядом с книгой.REM Удаляет только листы прошлого запуска: их список хранитсяREM в свойствах документа (Файл -> Свойства -> Свои свойства -> AXEL_split).Option Explicit Const SRC_SHEET = "Продажи"Const KEY_COL = 1                         ' столбец B (в LibreOffice счёт с нуля)Const OUT_FOLDER = "По менеджерам"Const TAG = "AXEL_split" Sub SplitByManager()    Dim oDoc As Object, oSheets As Object, oSrc As Object, oCur As Object    Dim oSh As Object, oNew As Object, oProps As Object    Dim data As Variant, part() As Variant, names() As String, v As Variant    Dim lastRow As Long, lastCol As Long, r As Long, k As Long, i As Long, n As Long    Dim m As String, sPath As String, sSep As String, sOut As String, own As String    Dim hidden(0) As New com.sun.star.beans.PropertyValue    Dim xlsx(0) As New com.sun.star.beans.PropertyValue     oDoc = ThisComponent    oSheets = oDoc.Sheets    If oDoc.getURL() = "" Then MsgBox "Сначала сохраните книгу." : Exit Sub    If Not oSheets.hasByName(SRC_SHEET) Then MsgBox "Нет листа «" & SRC_SHEET & "»." : Exit Sub    On Error GoTo Fail     ' 1. Границы данных и сами данные — одним массивом    oSrc = oSheets.getByName(SRC_SHEET)    oCur = oSrc.createCursor()    oCur.gotoEndOfUsedArea(False)    lastRow = oCur.RangeAddress.EndRow    lastCol = oCur.RangeAddress.EndColumn    data = oSrc.getCellRangeByPosition(0, 0, lastCol, lastRow).getDataArray()     ' 2. Убираем только наши листы прошлого запуска    oProps = oDoc.DocumentProperties.UserDefinedProperties    If oProps.getPropertySetInfo().hasPropertyByName(TAG) Then        For Each v In Split(oProps.getPropertyValue(TAG), "|")            If v <> "" And oSheets.hasByName(v) Then oSheets.removeByName(v)        Next v    Else        oProps.addProperty(TAG, com.sun.star.beans.PropertyAttribute.REMOVABLE, "")    End If     ' 3. Менеджеры без повторов, пустые пропускаем    n = -1    For r = 1 To lastRow        m = Trim(CStr(data(r)(KEY_COL)))        If m <> "" And IndexOf(names, n, m) < 0 Then            n = n + 1 : ReDim Preserve names(n) : names(n) = m        End If    Next r     ' 4. Подпапка рядом с книгой    sPath = ConvertFromURL(oDoc.getURL())    sSep = GetPathSeparator()    i = Len(sPath)    Do While Mid(sPath, i, 1) <> sSep : i = i - 1 : Loop    sOut = Left(sPath, i) & OUT_FOLDER    If Not FileExists(sOut) Then MkDir sOut    hidden(0).Name = "Hidden" : hidden(0).Value = True    xlsx(0).Name = "FilterName" : xlsx(0).Value = "Calc MS Excel 2007 XML"     ' 5. Каждому менеджеру: лист (копия с форматами) и файл .xlsx    For i = 0 To n        ReDim part(lastRow)        part(0) = data(0) : k = 0                         ' шапка        For r = 1 To lastRow            If LCase(Trim(CStr(data(r)(KEY_COL)))) = LCase(names(i)) Then                k = k + 1 : part(k) = data(r)            End If        Next r        ReDim Preserve part(k)        m = FreeName(oSheets, names(i))        oSheets.copyByName(SRC_SHEET, m, oSheets.getCount())    ' форматы и ширины        oSh = oSheets.getByName(m)        oSh.getCellRangeByPosition(0, 0, lastCol, k).setDataArray(part)  ' значения        If k < lastRow Then oSh.Rows.removeByIndex(k + 1, lastRow - k)        own = own & m & "|"         oNew = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, hidden())        oNew.Sheets.importSheet(oDoc, m, 0)        oNew.Sheets.removeByName(oNew.Sheets.getByIndex(1).Name)   ' пустой «Лист1»        oNew.storeToURL(ConvertToURL(sOut & sSep & Clean(names(i)) & ".xlsx"), xlsx())        oNew.close(True) : oNew = Nothing    Next i     oProps.setPropertyValue(TAG, own)    oDoc.CurrentController.setActiveSheet(oSrc)    MsgBox "Готово: листов и файлов — " & (n + 1) & Chr(10) & "Папка: " & sOut    Exit Sub Fail:    If Not IsNull(oNew) Then oNew.close(True)        ' не оставляем скрытых окон    MsgBox "Макрос остановлен: " & Error() & Chr(10) & "Лист «" & SRC_SHEET & "» не изменён."End Sub ' Номер строки s в массиве arr(0..last) без учёта регистра, иначе -1Function IndexOf(arr, last As Long, s As String) As Long    Dim j As Long    IndexOf = -1    For j = 0 To last        If LCase(arr(j)) = LCase(s) Then IndexOf = j : Exit Function    Next jEnd Function ' Заменяет символы, запрещённые в именах листов и файловFunction Clean(ByVal s As String) As String    Dim ch As Variant    For Each ch In Array("\", "/", ":", "*", "?", """", "<", ">", "|", "[", "]")        s = Join(Split(s, ch), "_")    Next ch    Clean = sEnd Function ' Свободное имя листа: если занято — «Имя (2)»Function FreeName(oSheets As Object, s As String) As String    Dim base As String, nm As String, j As Long    base = Left(Clean(s), 25) : nm = base : j = 1    Do While oSheets.hasByName(nm)        j = j + 1 : nm = base & " (" & j & ")"    Loop    FreeName = nmEnd Function

// ===== Макрос Р7-Офис (JavaScript) · сделано в AXEL 01.10.2026 =====// Разносит строки листа «Продажи» по листам менеджеров (столбец B).// Ничего не удаляет: если имя листа занято, создаёт «Имя (2)».// Макросы Р7-Офиса не пишут файлы на диск — каждый лист сохраните// через «Файл -> Сохранить копию как…» или возьмите версию для Excel.(function () {    var SRC = "Продажи", KEY = 1;           // B = 1, столбцы считаются с нуля    var src = Api.GetSheet(SRC);    if (!src) return;                       // нет листа — ничего не делаем     // 1. Шапка: сколько столбцов и какие форматы чисел во 2-й строке    var head = [], fmt = [], cols = 0;    while (src.GetRangeByNumber(0, cols).GetValue() !== "") {        head.push(src.GetRangeByNumber(0, cols).GetValue());        fmt.push(src.GetRangeByNumber(1, cols).GetNumberFormat());        cols++;    }     // 2. Строки группируем по менеджеру, пустые пропускаем    var groups = {}, order = [];    for (var r = 1; src.GetRangeByNumber(r, 0).GetValue() !== ""; r++) {        var row = [];        for (var c = 0; c < cols; c++) row.push(src.GetRangeByNumber(r, c).GetValue());        var m = String(row[KEY]).trim();        if (!m) continue;        if (!groups[m]) { groups[m] = []; order.push(m); }        groups[m].push(row);    }     // 3. Свободное имя листа: без запрещённых символов и совпадений    function freeName(s) {        var base = s.replace(/[\\\/?*\[\]:]/g, "_").slice(0, 25), name = base, n = 1;        while (Api.GetSheet(name)) { n++; name = base + " (" + n + ")"; }        return name;    }     // 4. Лист на каждого менеджера: шапка жирным, значения с форматами    order.forEach(function (m) {        Api.AddSheet(freeName(m));           // новый лист становится активным        var ws = Api.GetActiveSheet();        head.forEach(function (h, c) {            ws.GetRangeByNumber(0, c).SetValue(h);            ws.GetRangeByNumber(0, c).SetBold(true);        });        groups[m].forEach(function (row, i) {            row.forEach(function (v, c) {                var cell = ws.GetRangeByNumber(i + 1, c);                cell.SetValue(v);                cell.SetNumberFormat(fmt[c]);            });        });    });    src.SetActive();                          // возвращаемся на «Продажи»})();

/** * Разносит строки листа «Продажи» по менеджерам (столбец B): * свой лист в этой таблице и отдельная Google-таблица в папке * «По менеджерам» рядом с исходной (на Google Диске). * Удаляет только листы прошлого запуска (скрытая метка axel-split). * Сделано в AXEL 01.10.2026. Запуск: Расширения -> Apps Script -> ▶ splitByManager */const SRC_SHEET = 'Продажи';const KEY_COL = 2;                         // B = «Менеджер»const OUT_FOLDER = 'По менеджерам';const TAG = 'axel-split';                  // метка наших листов function splitByManager() {  const ss = SpreadsheetApp.getActive();  const src = ss.getSheetByName(SRC_SHEET);  if (!src) throw new Error('Не найден лист «' + SRC_SHEET + '»');  const range = src.getDataRange();  const values = range.getValues();  if (values.length < 2) throw new Error('На листе нет строк с данными');  const formats = range.getNumberFormats()[1];   // форматы 2-й строки  const head = values[0];   // 1. Убираем листы прошлого запуска — только с нашей меткой  ss.getSheets()    .filter(sh => sh.getDeveloperMetadata().some(d => d.getKey() === TAG))    .forEach(sh => ss.deleteSheet(sh));   // 2. Группируем строки по менеджеру, пустые пропускаем  const groups = new Map();  values.slice(1).forEach(row => {    const m = String(row[KEY_COL - 1]).trim();    if (!m) return;    if (!groups.has(m)) groups.set(m, []);    groups.get(m).push(row);  });   // 3. Папка «По менеджерам» рядом с таблицей  const parent = DriveApp.getFileById(ss.getId()).getParents().next();  const found = parent.getFoldersByName(OUT_FOLDER);  const folder = found.hasNext() ? found.next() : parent.createFolder(OUT_FOLDER);   // 4. Лист + отдельная таблица на каждого менеджера  groups.forEach((rows, m) => {    const sh = ss.insertSheet(freeName_(ss, m), ss.getNumSheets());    sh.addDeveloperMetadata(TAG);    sh.getRange(1, 1, rows.length + 1, head.length).setValues([head, ...rows]);    sh.getRange(2, 1, rows.length, head.length).setNumberFormats(rows.map(() => formats));    sh.getRange(1, 1, 1, head.length).setFontWeight('bold');     const file = SpreadsheetApp.create(m);    sh.copyTo(file).setName(m);    file.deleteSheet(file.getSheets()[0]);       // пустой «Лист1»    DriveApp.getFileById(file.getId()).moveTo(folder);  });   src.activate();  ss.toast('Готово: ' + groups.size + ' листов и таблиц в папке «' + OUT_FOLDER + '»', 'AXEL');} // Свободное имя листа: если занято — «Имя (2)»function freeName_(ss, name) {  let s = name, n = 1;  while (ss.getSheetByName(s)) s = name + ' (' + (++n) + ')';  return s;}