Могу ли я разделить электронную таблицу на несколько файлов на основе столбца в Excel 2007?

Есть ли в Excel способ разделить большой файл на несколько более мелких на основе содержимого одного столбца?

например: у меня есть файл данных о продажах для всех торговых представителей. Мне нужно отправить им файл, чтобы внести исправления и отправить обратно, но я не хочу отправлять каждому из них весь файл (потому что я не хочу, чтобы они меняли данные друг друга). Файл выглядит примерно так:

salesdata.xls

  RepName Контактное лицо с клиентомEmailAdam Cust1 admin@cust1.comAdam Cust2 admin@cust2.comBob Cust3 blah  @ cust3.cometc ...  

из этого мне нужно:

salesdata_Adam.xls

  RepName Контактный адрес клиентаEmailAdam Cust1 admin@cust1.comAdam Cust2 admin@cust2.com  

и salesdata_Bob.xls

  Боб Каст3  blah@cust3.com  

Есть ли что-нибудь, встроенное в Excel 2007, чтобы делать это автоматически, или мне следует отказаться от VBA?


Насколько я знаю, нет ничего, кроме макроса, который разделит ваши данные и автоматически сохранит их в набор файлов. VBA, вероятно, проще.

Update Я выполнил свое предложение. Он перебирает все имена, определенные в именованном диапазоне RepList. Именованный диапазон — это динамический именованный диапазон вида = OFFSET (Names! $ A $ 2,0,0, COUNTA (Names! $ A: $ A) -1,1)

, модуль следует .

  Option Explicit 'Разделить данные о продажах на отдельные столбцы на основе имен, определенных в Списке торговых представителей на листе' Имена '. Sub SplitSalesData () Dim wb As Workbook  Dim p As Range Application.ScreenUpdating = False For Each p In Sheets ("Names"). Range ("RepList") Workbooks.Add Set wb = ActiveWorkbook ThisWorkbook.Activate WritePersonToWorkbook wb, p.Value wb.SaveAs ThisWorkbook.Path & "   salesdata_ "& p.Value wb.Close Next p Application.ScreenUpdating = True Set wb = NothingEnd Sub'Записывает все строки данных о продажах, принадлежащие человеку, на первый лист в названной книге SalesWB.Sub WritePersonToWorkbook (ByVal SalesWB As Workbook  , _ ByVal Person As String) Dim rw As Range Dim personRows As Range 'Сохраняет все найденные строки', содержащие Person в столбце 1 Для каждого rw в UsedRange.Rows Если Person = rw.Cells (1, 1) Тогда Если personRows Is  Nothing Then Set personR  ows = rw Else Set personRows = Union (personRows, rw) End If End If Next rw personRows.Copy SalesWB.Sheets (1) .Cells (1, 1) Ser personRows = NothingEnd Sub  

Эта книга содержит код и именованный диапазон. Код является частью таблицы «Данные о продажах».


Для потомков вот еще один макрос для решения эта проблема.

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

Итак, нет необходимости изменять код или подготавливать именованный диапазон. Макрос начинается с запроса пользователю столбца для обработки, а также номера строки, с которой следует начать — то есть пропустить заголовки, и переходит оттуда.

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

Файлы являются сохраняется в подпапке Split со значением ячейки в качестве имени файла. Я еще не тестировал его на различных документах, но он работает с моими примерами файлов. Не стесняйтесь попробовать и дайте мне знать, если у вас возникнут проблемы.

Макрос можно сохранить как надстройку Excel (xlam), чтобы добавить кнопку на кнопку панели инструментов ленты/быстрого доступа для легкий доступ.

  Public Sub SplitToFiles () 'MACRO SplitToFiles' Последнее обновление: 2019-05-28 'Автор: mtone' Версия 1.2 'Описание:' Цикл по указанному столбцу  , и разделите каждое отдельное значение в отдельный файл, сделав копию и удалив строки ниже и выше '' Примечание: значения в столбце должны быть уникальными или отсортированными ''. Следующие ячейки игнорируются при разделении разделов: '- пустые ячейки,  или содержащие только пробелы '- повторяется одно и то же значение' - ячейки, содержащие «всего» '' Файлы сохраняются в подпапке «Разделить» из местоположения исходной книги и именуются по имени раздела. Im osh As Worksheet 'Исходный листDim iRow  As Long 'CursorsDim iCol As LongDim iFirstRow As Long' ConstantDim iTotalRows As Long 'ConstantDim iStartRow As Long' Разделители разделовDim iStopRow As LongDim sSec  tionName As String 'Имя раздела (и имя файла) Dim rCell As Range' текущая ячейкаDim owb As Workbook 'Исходная рабочая книгаDim sFilePath As String' ConstantDim iCount As Integer 'Количество созданных документов iCol = Application.InputBox («Введите номер столбца, используемый для разделения»  , «Выбрать столбец», 2,,,,, 1) iRow = Application.InputBox («Введите начальный номер строки (чтобы пропустить заголовок)», «Выбрать строку», 2,,,,, 1) iFirstRow = iRowSet osh  = Application.ActiveSheetSet owb = Application.ActiveWorkbookiTotalRows = osh.UsedRange.Rows.CountsFilePath = Application.ActiveWorkbook.PathIf Dir (sFilePath + " Split", vbDirectory) = "" Затем MkDir sFiturnPath + "TotalRows" Если  Обновление экрана EventsApplication.EnableEvents = FalseApplication.ScreenUpdating = FalseDo 'Получить ячейку в курсоре Set rCell = osh.Cells (iRow, iCol) sCell = Replace (rCell.Text, "", "") Если sCell = "" Или (rCell. Text = sSectionName And iStartRow  0) или InStr (1, rCell.Text, "total", vbTextCompare)  0 Тогда 'Выполнено условие пропуска Else' Найден новый раздел Если iStartRow = 0 Then 'Разделитель StartRow не установлен, что означает начало  новый раздел sSectionName = rCell.Text iStartRow = iRow Else 'Установлен разделитель StartRow, что означает, что мы достигли конца раздела iStopRow = iRow - 1' Передайте переменные в отдельную подпрограмму для создания и сохранения нового листа CopySheet osh, iFirstRow, iStartRow  , iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat iCount = iCount + 1 'Сбросить разделители разделов iStartRow = 0 iStopRow = 0' Готов продолжить цикл iRow = iRow - 1 End If End If 'Продолжить, пока не будет достигнута последняя строка If iRow   iStopRow Then DeleteRows ash, iStopRow + 1, iTotalRows End If 'Удалить строки  перед разделом Если iStartRow> iFirstRow Then DeleteRows ash, iFirstRow, iStartRow - 1 End If 'Выбрать крайнюю левую ячейку ash.Cells (1, 1) .Select' Очистить несколько символов, чтобы предотвратить недопустимое имя файла sSectionName = Replace (sSectionName, " /"," ") sSectionName = Заменить (sSectionName,"  "," ") sSectionName = Заменить (sSectionName,": "," ") sSectionName = Заменить (sSectionName," = "," ") sSectionName = Заменить (sSectionName  , "*", "") sSectionName = Replace (sSectionName, ".", "") sSectionName = Replace (sSectionName, "?", "") sSectionName = Strings.Trim (sSectionName) 'Сохранить в том же формате, что и исходная книга  ash.SaveAs sFilePath + " Split " + sSectionName, fileFormat 'Close Set awb = ash.Parent awb.Close SaveChanges: = FalseEnd Sub  


Вот еще один макрос для решения этой проблемы для потомков..

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

Итак, нет необходимости изменять код или подготавливать именованный диапазон. Макрос начинается с запроса пользователю столбца для обработки, а также номера строки, с которой следует начать — то есть пропустить заголовки, и переходит оттуда.

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

Файлы являются сохраняется в подпапке Split со значением ячейки в качестве имени файла. Я еще не тестировал его на различных документах, но он работает с моими примерами файлов. Не стесняйтесь попробовать и дайте мне знать, если у вас возникнут проблемы.

Макрос можно сохранить как надстройку Excel (xlam), чтобы добавить кнопку на кнопку панели инструментов ленты/быстрого доступа для легкий доступ.

  Public Sub SplitToFiles () 'MACRO SplitToFiles' Последнее обновление: 2019-05-28 'Автор: mtone' Версия 1.2 'Описание:' Цикл по указанному столбцу  , и разделите каждое отдельное значение в отдельный файл, сделав копию и удалив строки ниже и выше '' Примечание: значения в столбце должны быть уникальными или отсортированными ''. Следующие ячейки игнорируются при разделении разделов: '- пустые ячейки,  или содержащие только пробелы '- повторяется одно и то же значение' - ячейки, содержащие «всего» '' Файлы сохраняются в подпапке «Разделить» из местоположения исходной книги и именуются по имени раздела. Im osh As Worksheet 'Исходный листDim iRow  As Long 'CursorsDim iCol As LongDim iFirstRow As Long' ConstantDim iTotalRows As Long 'ConstantDim iStartRow As Long' Разделители разделовDim iStopRow As LongDim sSec  tionName As String 'Имя раздела (и имя файла) Dim rCell As Range' текущая ячейкаDim owb As Workbook 'Исходная рабочая книгаDim sFilePath As String' ConstantDim iCount As Integer 'Количество созданных документов iCol = Application.InputBox («Введите номер столбца, используемый для разделения»  , «Выбрать столбец», 2,,,,, 1) iRow = Application.InputBox («Введите номер начальной строки (чтобы пропустить заголовок)», «Выбрать строку», 2,,,,, 1) iFirstRow = iRowSet osh  = Application.ActiveSheetSet owb = Application.ActiveWorkbookiTotalRows = osh.UsedRange.Rows.CountsFilePath = Application.ActiveWorkbook. PathIf Dir (sFilePath + " Split", vbDirectory) = "" Then MkDir sFilePath + " Split" End If 'Отключить обновление экрана EventsApplication.EnableEvents = FalseApplication.ScreenUpdating = FalseDo' Получить ячейку на курсоре Установить rCell = osh.Cells  (iRow, iCol) sCell = Replace (rCell.Text, "", "") If sCell = "" Или (rCell.Text = sSectionName And iStartRow  0) Или InStr (1, rCell.Text, "total",  vbTextCompare)  0 Then 'Пропустить условие выполнено Else' Найден новый раздел If iStartRow = 0 Then 'Разделитель StartRow не установлен, что означает начало нового раздела sSectionName = rCell.Text iStartRow = iRow Else' Установлен разделитель StartRow, что означает, что мы достигли конца  раздела iStopRow = iRow - 1 'Передайте переменные в отдельную подпрограмму, чтобы создать и сохранить новый лист CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat iCount = iCount + 1' Сбросить разделители разделов iStart  = 0 iStopRow = 0 'Готов к продолжению цикла iRow = iRow - 1 End If End If' Продолжать до повторной загрузки последней строки  hed If iRow  iStopRow Then DeleteRows ash, iStopRow + 1, iTotalRows End If 'Удалить строки  перед разделом Если iStartRow> iFirstRow Then DeleteRows ash, iFirstRow, iStartRow - 1 End If 'Выбрать крайнюю левую ячейку ash.Cells (1, 1) .Select' Очистить несколько символов, чтобы предотвратить недопустимое имя файла sSectionName = Replace (sSectionName, " /"," ") sSectionName = Заменить (sSectionName,"  "," ") sSectionName = Заменить (sSectionName,": "," ") sSectionName = Заменить (sSectionName," = "," ") sSectionName = Заменить (sSectionName  , "*", "") sSectionName = Replace (sSectionName, ".", "") sSectionName = Replace (sSectionName, "?", "") sSectionName = Strings.Trim (sSectionName) 'Сохранить в том же формате, что и исходная книга  ясень. SaveAs sFilePath + " Split " + sSectionName, fileFormat 'Close Set awb = ash.Parent awb.Close SaveChanges: = FalseEnd Sub  

Если кто-то другой ответит, как это сделать и быстро, проигнорируйте этот ответ.

Я лично использую Excel, а затем много трачу времени (иногда часы) в поисках сложного способа что-то сделать или чрезмерного уравнения, которое сделает все, когда я никогда не буду его использовать снова … и оказывается, что если я просто сяду и продолжу работу вручную это займет меньше времени.


Если у вас всего несколько человек, я рекомендую вам просто выделить все данные, перейти на вкладку данных и нажмите кнопку сортировки.

Затем вы можете выбрать, что столбец для сортировки, в вашем случае вы хотите использовать Repname, а затем просто скопируйте и вставьте в отдельные файлы.

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

Кроме того, я думаю, что вы можете делать такие вещи на сервисах sharepoint + excel, но это лучшее решение для такого рода вещей.


Если кто-то другой ответит, как это сделать и быстро, проигнорируйте этот ответ.

Я лично использую Excel и затем потратить много времени (иногда часы) на поиск сложного способа что-то сделать или чрезмерного уравнения, которое сделает все, когда я никогда не буду использовать его снова … и оказывается, что если бы я просто сел и получил на выполнение задачи вручную это заняло бы долю времени.


Если у вас всего несколько человек, то я рекомендую вам просто выделить t все данные, перейдите на вкладку данных и нажмите кнопку сортировки.

Затем вы можете выбрать столбец для сортировки, в вашем случае вы хотите использовать Repname, а затем просто скопировать и вставить в отдельные файлы.

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

Кроме того, я думаю, что вы можете делать такие вещи в сервисах sharepoint + excel, но это лучшее решение для такого рода вещей.


Хорошо, вот первый фрагмент VBA. Вы называете это так:

  Диапазон SplitIntoFiles («A1: N1»), Диапазон («A2: N2»), Диапазон («B2»), «Разделить файл -  " 

Где A1: N1 — строка (строки) заголовка, A2: N2 — первая строка ваших данных, B2 ​​- первая ячейка в предварительно отсортированном ключевом столбце. Последний аргумент — это префикс имени файла. Ключ будет добавлен к этому перед сохранением.

Отказ от ответственности: этот код неприятен.

  Option ExplicitPublic Sub SplitIntoFiles (headerRange As Range, startRange As Range, keyCell As Range, filenameBase As String) 'предполагаем, что столбец keyCell уже отсортирован' начать новую книгу Dim wb  Как рабочая книга Dim ws As Worksheet Set wb = Application.Workbooks.Add Set ws = wb.ActiveSheet Dim destRange As Range Set destRange = ws.Range ("A1") 'скопировать headerRange.Copy destRange Set destRange = destRange.Offset (headerRange  .Rows.Count) Dim keyValue As Variant keyValue = "" Пока keyCell.Value  "" 'если у нас есть новый ключ, сохраните файл и запустите новый If (keyValue  keyCell.Value) Then If  keyValue  "" Затем 'TODO: удалить символы, отличные от имени файла, из keyValue wb.SaveAs filenameBase & CStr (keyValue) wb.Close False Set wb = Application.Workbooks.Add Set ws = wb.ActiveSheet Set destRange = ws.Range (  "A1") 'копировать заголовок headerRange.Copy destRange Set destRange = destRange.Offset (headerRange.Rows.Count) End If End If keyValue = keyCell.Value' копировать содержимое t  его строку на новый лист startRange.Copy destRange Установить keyCell = keyCell.Offset (1) Установить destRange = destRange.Offset (1) Установить startRange = startRange.Offset (1) Wend 'сохранить остаток' TODO: удалить символы, отличные от имени файла, из  keyValue wb.SaveAs filenameBase & CStr (keyValue) wb.CloseEnd Sub  


Хорошо, вот и первая часть VBA. Вы называете это так:

  Диапазон SplitIntoFiles («A1: N1»), Диапазон («A2: N2»), Диапазон («B2»), «Разделить файл -  " 

Где A1: N1 — строка (строки) заголовка, A2: N2 — первая строка ваших данных, B2 ​​- первая ячейка в предварительно отсортированном ключевом столбце. Последний аргумент — это префикс имени файла. Ключ будет добавлен к этому перед сохранением.

Отказ от ответственности: этот код неприятен.

  Option ExplicitPublic Sub SplitIntoFiles (headerRange As Range, startRange As Range, keyCell As Range, filenameBase As String) 'предполагаем, что столбец keyCell уже отсортирован' начать новую книгу Dim wb  Как рабочая книга Dim ws As Worksheet Set wb = Application.Workbooks.Add Set ws = wb.ActiveSheet Dim destRange As Range Set destRange = ws.Range ("A1") 'скопировать headerRange.Copy destRange Set destRange = destRange.Offset (headerRange  .Rows.Count) Dim keyValue As Variant keyValue = "" Пока keyCell. Value  "" ', если у нас есть новый ключ, сохраните файл и начните новый. If (keyValue  keyCell.Value) Then If keyValue  "" Then' TODO: удалить символы, отличные от имени файла, из keyValue  wb.SaveAs filenameBase & CStr (keyValue) wb.Close False Set wb = Application.Workbooks.Add Set ws = wb.ActiveSheet Set destRange = ws.Range ("A1") 'копировать заголовок headerRange.Copy destRange Установить destRange = destRange.  Offset (headerRange.Rows.Count) End If End If keyValue = keyCell.Value 'скопируйте содержимое этой строки на новый лист startRange.Copy destRange Set keyCell = keyCell.Offset (1) Set destRange = destRange.Offset (1)  Установите startRange = startRange.Offset (1) Wend 'save остаток' TODO: удалить символы, отличные от имени файла, из keyValue wb.SaveAs filenameBase & CStr (keyValue) wb.CloseEnd Sub  

Я сортирую по имени и вставляю информацию прямо во второй лист Excel, тот, который вы хотите отправить. Excel вставляет только видимые строки, но не скрытые строки. Я также защищаю все ячейки, кроме тех, которые я хочу обновить. лол.


Я сортирую по имени и вставляю информацию прямо во второй лист Excel, тот, который вы хотите отправить. Excel вставляет только видимые строки, но не скрытые строки. Я также защищаю все ячейки, за исключением ячеек, которые я хочу обновить. лол.

Оцените статью
techsly.ru
Добавить комментарий