Добрый день, друзья! Прошу Вас всех помочь разобраться с моим примером! Есть сводная таблица по нескольким фирмам и затраченным суммам. Фирмы проставляют статус оплаты. При рассылке писем приходится удалять строки, относящиеся к другим фирмам. Возможно ли наладить с помощь формул или макроса (формулы в приоритете) такой момент: есть несколько отдельных таблиц (по кол-ву фирм в общем файле) куда перетекает по формуле инфа из сводной таблицы, то есть по каждой отдельной фирме в отдельную таблицу. После этого чтобы осталось только скинуть отдельный файлик в письмо для отправки контрагенту.
Возможно кто то поймет суть вопроса и скажет более легкий путь решения проблемы. Буду рад услышать все мнения. Заранее спасибо!
Добрый день, друзья! Прошу Вас всех помочь разобраться с моим примером! Есть сводная таблица по нескольким фирмам и затраченным суммам. Фирмы проставляют статус оплаты. При рассылке писем приходится удалять строки, относящиеся к другим фирмам. Возможно ли наладить с помощь формул или макроса (формулы в приоритете) такой момент: есть несколько отдельных таблиц (по кол-ву фирм в общем файле) куда перетекает по формуле инфа из сводной таблицы, то есть по каждой отдельной фирме в отдельную таблицу. После этого чтобы осталось только скинуть отдельный файлик в письмо для отправки контрагенту.
Возможно кто то поймет суть вопроса и скажет более легкий путь решения проблемы. Буду рад услышать все мнения. Заранее спасибо!alekuvaldin
дык какая инфа должна перетекать?в каком виде д.б. эта таблица? у вас в файле только сводная
грубо говоря если в сводной 5 фирм - то должно быть 5 отдельных файлов с инфой только по каждой отдельной фирме. форматирование аналогично сводной таблицы
дык какая инфа должна перетекать?в каком виде д.б. эта таблица? у вас в файле только сводная
грубо говоря если в сводной 5 фирм - то должно быть 5 отдельных файлов с инфой только по каждой отдельной фирме. форматирование аналогично сводной таблицыalekuvaldin
Сообщение отредактировал alekuvaldin - Среда, 07.10.2015, 13:20
там то как то проще получилось... вставил и заработало. а с формулой отсюда я недопетрил (туговато для моего мозга ) Огромное приогромное спасибо! Сейчас все сделал-все работает "крутится-вертится" - так приятно смотреть!!!
там то как то проще получилось... вставил и заработало. а с формулой отсюда я недопетрил (туговато для моего мозга ) Огромное приогромное спасибо! Сейчас все сделал-все работает "крутится-вертится" - так приятно смотреть!!! alekuvaldin
Вот тут тоже помогают решить проблему: http://www.planetaexcel.ru/forum....e589491 Есть решение (Пример) - помог Vik_tor Однако проблема в том, что у получателя отображаются все строки как формулы( Опять же Vik_tor доработал пример с другой формулой ( с другого сайта ) попробовал скрестить с макросом (alekuvaldin+ макрос). он размножает листы шаблона с формулой по числу фирм. Надо бы заменить формулы на значения (для рассылки) , но так как я в макросах не очень, возможно кто-то поможет разобраться как это сделать
Вот тут тоже помогают решить проблему: http://www.planetaexcel.ru/forum....e589491 Есть решение (Пример) - помог Vik_tor Однако проблема в том, что у получателя отображаются все строки как формулы( Опять же Vik_tor доработал пример с другой формулой ( с другого сайта ) попробовал скрестить с макросом (alekuvaldin+ макрос). он размножает листы шаблона с формулой по числу фирм. Надо бы заменить формулы на значения (для рассылки) , но так как я в макросах не очень, возможно кто-то поможет разобраться как это сделать alekuvaldin
alekuvaldin, 1 строчку в макрос добавила: ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
и включение/отключение пересчета формул (Application.Calculation) переместила внутрь цикла К сообщению приложен файл: alekuvaldin_11.xlsb(33Kb)
Да,благодарю! Вопрос: можно ли реализовать и как вывод данных не на отд.лист этого документа а в отдельный документ (по кол-ву фирм) и еще. возможно ли дополнить данный файл макросом при выполнении которого откроются новые письма в Outlook(по кол-ву фирм) Во вложении каждого письма будет либо лист (как в первом вашем случае) либо новый файл (в случае реализациии моего первого вопроса) а письмо бы дополнялось стандартным текстом. Отправка писем ручная, а не по выполнению макроса. Или это уже из области фантастики??
alekuvaldin, 1 строчку в макрос добавила: ActiveSheet.UsedRange = ActiveSheet.UsedRange.Value
и включение/отключение пересчета формул (Application.Calculation) переместила внутрь цикла К сообщению приложен файл: alekuvaldin_11.xlsb(33Kb)
Да,благодарю! Вопрос: можно ли реализовать и как вывод данных не на отд.лист этого документа а в отдельный документ (по кол-ву фирм) и еще. возможно ли дополнить данный файл макросом при выполнении которого откроются новые письма в Outlook(по кол-ву фирм) Во вложении каждого письма будет либо лист (как в первом вашем случае) либо новый файл (в случае реализациии моего первого вопроса) а письмо бы дополнялось стандартным текстом. Отправка писем ручная, а не по выполнению макроса. Или это уже из области фантастики?? alekuvaldin
Sub КопияШаблонаСписком() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculateManual Dim i As Long Sheets("Шаблон").Visible = True Dim rng: rng = Sheets("ТО").Range("n3:n" & Sheets("ТО").Cells(Rows.Count, "n").End(xlUp).Row) With CreateObject("Scripting.Dictionary"): .CompareMode = 1 For i = LBound(rng, 1) To UBound(rng, 1) If .Item(Trim(rng(i, 1))) <> "" Then .Item(Trim(rng(i, 1))) = .Item(Trim(rng(i, 1))) + 1 Next i Dim arrKeys: arrKeys = .keys For i = 0 To UBound(arrKeys) Sheets("Шаблон").Copy Before:=Sheets("<") ActiveSheet.Name = arrKeys(i) Application.Calculation = xlAutomatic Sheets(arrKeys(i)).UsedRange = Sheets(arrKeys(i)).UsedRange.Value Application.Calculation = xlCalculateManual Sheets(arrKeys(i)).Move With ActiveWorkbook .SaveAs Replace(ThisWorkbook.Path & "\" & arrKeys(i) & ".xlsx", """", "") .Close End With Next i End With Sheets("Шаблон").Visible = False Application.Calculation = xlAutomatic Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Sub КопияШаблонаСписком() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculateManual Dim i As Long Sheets("Шаблон").Visible = True Dim rng: rng = Sheets("ТО").Range("n3:n" & Sheets("ТО").Cells(Rows.Count, "n").End(xlUp).Row) With CreateObject("Scripting.Dictionary"): .CompareMode = 1 For i = LBound(rng, 1) To UBound(rng, 1) If .Item(Trim(rng(i, 1))) <> "" Then .Item(Trim(rng(i, 1))) = .Item(Trim(rng(i, 1))) + 1 Next i Dim arrKeys: arrKeys = .keys For i = 0 To UBound(arrKeys) Sheets("Шаблон").Copy Before:=Sheets("<") ActiveSheet.Name = arrKeys(i) Application.Calculation = xlAutomatic Sheets(arrKeys(i)).UsedRange = Sheets(arrKeys(i)).UsedRange.Value Application.Calculation = xlCalculateManual Sheets(arrKeys(i)).Move With ActiveWorkbook .SaveAs Replace(ThisWorkbook.Path & "\" & arrKeys(i) & ".xlsx", """", "") .Close End With Next i End With Sheets("Шаблон").Visible = False Application.Calculation = xlAutomatic Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
Приветствую!! А сколько может потребоваться времени на написание такого файла самому если начать изучение макросов с 0? Пытался перенести последний Ваш макрос на свой файл но не получается Не можете ли еще раз помочь? Был бы очень признателен
Приветствую!! А сколько может потребоваться времени на написание такого файла самому если начать изучение макросов с 0? Пытался перенести последний Ваш макрос на свой файл но не получается Не можете ли еще раз помочь? Был бы очень признателенalekuvaldin
alekuvaldin, Вы не перенесли код в свой файл. Ваш макрос расположен на скрытом листе Шаблон, скопируйте этот лист в свой файл. В макросе идет ориентация на лист с именем "<", ее можно убрать, раз Вы новые книги сохраняете, а не листы. Это я в тот раз не углядела. Держите скорректированный код: [vba]
Код
Sub КопияШаблонаСписком() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculateManual Dim i As Long Sheets("Шаблон").Visible = True Dim rng: rng = Sheets("ТО").Range("n3:n" & Sheets("ТО").Cells(Rows.Count, "n").End(xlUp).Row) With CreateObject("Scripting.Dictionary"): .CompareMode = 1 For i = LBound(rng, 1) To UBound(rng, 1) If .Item(Trim(rng(i, 1))) <> "" Then .Item(Trim(rng(i, 1))) = .Item(Trim(rng(i, 1))) + 1 Next i Dim arrKeys: arrKeys = .keys For i = 0 To UBound(arrKeys) Sheets("Шаблон").Copy With ActiveWorkbook .ActiveSheet.Name = arrKeys(i) Application.Calculation = xlAutomatic .Sheets(arrKeys(i)).UsedRange = Sheets(arrKeys(i)).UsedRange.Value Application.Calculation = xlCalculateManual .SaveAs Replace(ThisWorkbook.Path & "\" & arrKeys(i) & ".xlsx", """", "") .Close End With Next i End With Sheets("Шаблон").Visible = False Application.Calculation = xlAutomatic Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Кстати, сам макрос, я бы тоже положила в обычный модуль, а не в модуль листа...
alekuvaldin, Вы не перенесли код в свой файл. Ваш макрос расположен на скрытом листе Шаблон, скопируйте этот лист в свой файл. В макросе идет ориентация на лист с именем "<", ее можно убрать, раз Вы новые книги сохраняете, а не листы. Это я в тот раз не углядела. Держите скорректированный код: [vba]
Код
Sub КопияШаблонаСписком() Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlCalculateManual Dim i As Long Sheets("Шаблон").Visible = True Dim rng: rng = Sheets("ТО").Range("n3:n" & Sheets("ТО").Cells(Rows.Count, "n").End(xlUp).Row) With CreateObject("Scripting.Dictionary"): .CompareMode = 1 For i = LBound(rng, 1) To UBound(rng, 1) If .Item(Trim(rng(i, 1))) <> "" Then .Item(Trim(rng(i, 1))) = .Item(Trim(rng(i, 1))) + 1 Next i Dim arrKeys: arrKeys = .keys For i = 0 To UBound(arrKeys) Sheets("Шаблон").Copy With ActiveWorkbook .ActiveSheet.Name = arrKeys(i) Application.Calculation = xlAutomatic .Sheets(arrKeys(i)).UsedRange = Sheets(arrKeys(i)).UsedRange.Value Application.Calculation = xlCalculateManual .SaveAs Replace(ThisWorkbook.Path & "\" & arrKeys(i) & ".xlsx", """", "") .Close End With Next i End With Sheets("Шаблон").Visible = False Application.Calculation = xlAutomatic Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
[/vba] Кстати, сам макрос, я бы тоже положила в обычный модуль, а не в модуль листа...Manyasha
alekuvaldin, Вы не перенесли код в свой файл. Ваш макрос расположен на скрытом листе Шаблон, скопируйте этот лист в свой файл. В макросе идет ориентация на лист
Спасибо приогромное за Вашу помощь! Вот так еще помогли - в файле прикрепил
alekuvaldin, Вы не перенесли код в свой файл. Ваш макрос расположен на скрытом листе Шаблон, скопируйте этот лист в свой файл. В макросе идет ориентация на лист
Спасибо приогромное за Вашу помощь! Вот так еще помогли - в файле прикрепилalekuvaldin