Добрый день. Надеюсь, что кто-нибудь из Вас сталкивался с подобным. Рассчитываю на Вашу мудрость)) Предыстория: Прикладываемые файлы урезаны, но их оригиналы содержат большое кол-во формул и расчетов. Поэтому не хотелось бы глобально изменять табличную часть. Также не рассматривается переход на плоскую таблицу. Условия: 1) Дан ряд файлов “*.xlms”, с последовательным наименованием (03.18, 04.18, 05.18) 2) Каждый документ состоит более чем из 20 листов идентичных по форме заполнения, отличающихся данными. 3) У каждого листа имеется наименование (название розничной точки) , также книга содержит несколько листов с общими данными. Задача: В идеале – создать кнопку (Пересчет) на листе Доп.данные. Которая: 1) При использовании функции “Индекс Поискпоз”, на листах (от Магазин№1 до Магазин№Х), в массиве C7:H26 , переносила бы не только значения, вычисленные функцией, но и цвет их ячеек. Это будет? другой пост. Отвечающих просьба пока решать только первый вопрос. Борода 2) Для того, чтобы не было необходимости каждый раз переписывать функцию (индекс поискпоз) в том же диапазоне C7:H26, необходима возможность изменять часть текста функции, используя ячейку или всплывающее окно.
Как видно из функции, она ссылается на документ [04.18.xlsm] из документа 05.18. Но по прошествии месяца, мне придется переписывать функцию, ссылаясь на документ [05.18.xlsm] из документа 06.18. Отлично бы реализовать следующее: При нажатии на кнопку “Пересчет” происходило не только перетягивание данных с цветом ячейки, но и изменение функцИЙ (индекс поискпоз), в массиве C7:H26, на листах магазинов, на основании ячейки D2(отражающую документ на который ссылается функция)
P.S. - мне рекомендовали создать тему в этой ветке.
Добрый день. Надеюсь, что кто-нибудь из Вас сталкивался с подобным. Рассчитываю на Вашу мудрость)) Предыстория: Прикладываемые файлы урезаны, но их оригиналы содержат большое кол-во формул и расчетов. Поэтому не хотелось бы глобально изменять табличную часть. Также не рассматривается переход на плоскую таблицу. Условия: 1) Дан ряд файлов “*.xlms”, с последовательным наименованием (03.18, 04.18, 05.18) 2) Каждый документ состоит более чем из 20 листов идентичных по форме заполнения, отличающихся данными. 3) У каждого листа имеется наименование (название розничной точки) , также книга содержит несколько листов с общими данными. Задача: В идеале – создать кнопку (Пересчет) на листе Доп.данные. Которая: 1) При использовании функции “Индекс Поискпоз”, на листах (от Магазин№1 до Магазин№Х), в массиве C7:H26 , переносила бы не только значения, вычисленные функцией, но и цвет их ячеек. Это будет? другой пост. Отвечающих просьба пока решать только первый вопрос. Борода 2) Для того, чтобы не было необходимости каждый раз переписывать функцию (индекс поискпоз) в том же диапазоне C7:H26, необходима возможность изменять часть текста функции, используя ячейку или всплывающее окно.
Как видно из функции, она ссылается на документ [04.18.xlsm] из документа 05.18. Но по прошествии месяца, мне придется переписывать функцию, ссылаясь на документ [05.18.xlsm] из документа 06.18. Отлично бы реализовать следующее: При нажатии на кнопку “Пересчет” происходило не только перетягивание данных с цветом ячейки, но и изменение функцИЙ (индекс поискпоз), в массиве C7:H26, на листах магазинов, на основании ячейки D2(отражающую документ на который ссылается функция)
P.S. - мне рекомендовали создать тему в этой ветке.EvgeniyVS
_Boroda_, добрый день. Я описал задачу целиком, чтобы была возможность увидеть картину в целом. Что если реализовать решение через VBA, не используя (ИндексПоискпоз).
Но если выбрать необходимо, то я ищу помощь в написании кода, который позволит переносить не только данные но и цвет ячейки. Мне необходимо внести изменения в первоначальный пост?
_Boroda_, добрый день. Я описал задачу целиком, чтобы была возможность увидеть картину в целом. Что если реализовать решение через VBA, не используя (ИндексПоискпоз).
Но если выбрать необходимо, то я ищу помощь в написании кода, который позволит переносить не только данные но и цвет ячейки. Мне необходимо внести изменения в первоначальный пост?EvgeniyVS
Sub FindValues_WithColors() Dim Wb As Workbook Dim mSh As Worksheet, Sh As Worksheet Dim i&, ii&, StrRo, StrCo, iT&, iiT&
For Each mSh In ActiveWindow.SelectedSheets mSh.Select Set Wb = Workbooks.Open(ActiveWorkbook.Path & "\" & mSh.Range("d1").Value) Set Sh = Wb.Sheets(mSh.Name) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 7 To mSh.UsedRange.Rows.Count If Len(mSh.Cells(i, 2)) = 0 Then Exit For StrRo = mSh.Cells(i, 2) For ii = 3 To 8 StrCo = mSh.Cells(6, ii) For iT = 7 To Sh.UsedRange.Rows.Count For iiT = 10 To 50 If StrRo = Sh.Cells(iT, 2) And StrCo = Sh.Cells(1, iiT) Then mSh.Cells(i, ii).Value = Sh.Cells(iT, iiT).Value mSh.Cells(i, ii).Interior.Color = Sh.Cells(iT, iiT).Interior.Color End If Next Next Next Next Wb.Close False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
[/vba]
как то так: [vba]
Код
Sub FindValues_WithColors() Dim Wb As Workbook Dim mSh As Worksheet, Sh As Worksheet Dim i&, ii&, StrRo, StrCo, iT&, iiT&
For Each mSh In ActiveWindow.SelectedSheets mSh.Select Set Wb = Workbooks.Open(ActiveWorkbook.Path & "\" & mSh.Range("d1").Value) Set Sh = Wb.Sheets(mSh.Name) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 7 To mSh.UsedRange.Rows.Count If Len(mSh.Cells(i, 2)) = 0 Then Exit For StrRo = mSh.Cells(i, 2) For ii = 3 To 8 StrCo = mSh.Cells(6, ii) For iT = 7 To Sh.UsedRange.Rows.Count For iiT = 10 To 50 If StrRo = Sh.Cells(iT, 2) And StrCo = Sh.Cells(1, iiT) Then mSh.Cells(i, ii).Value = Sh.Cells(iT, iiT).Value mSh.Cells(i, ii).Interior.Color = Sh.Cells(iT, iiT).Interior.Color End If Next Next Next Next Wb.Close False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
SLAVICK, доброе утро. И снова Вы выручаете, спасибо. Правильно ли я понял, что данная формула отвечает за изменение (индек споискпоз)? К сожалению, не удалось восстановить ее работоспособность. И еще вопрос: Возможно ли вшить перечень листов в код, а кнопку перенести на лист доп.данные?
SLAVICK, доброе утро. И снова Вы выручаете, спасибо. Правильно ли я понял, что данная формула отвечает за изменение (индек споискпоз)? К сожалению, не удалось восстановить ее работоспособность. И еще вопрос: Возможно ли вшить перечень листов в код, а кнопку перенести на лист доп.данные?EvgeniyVS
что данная формула отвечает за изменение (индек споискпоз)?
нет. Этот макрос открывает книгу,название которой находится в зеленой ячейке D1, которая находится в той же папке, что и текущая книга. ищет ФИО на одноименном листе в этой книге, и дату - и, если находит - подставляет уже готовые значения И ЗАЛИВКУ в столбцы "С-Н" Таким образом необходимость в формуле - и ее изменении отпадает.
Возможно ли вшить перечень листов в код, а кнопку перенести на лист доп.данные?
для этого замените [vba]
Код
ActiveWindow.SelectedSheets
[/vba] на [vba]
Код
Sheets(Array("Магазин №1", "Магазин №2"))
[/vba] Добавлено Почему у вас в магазине 1 и магазине 2 - разная структура и формулы? Данные начинаются с 4-го столбца, а не с 10-го - но это полбеды Формулы в одном листе - возвращают текстовое представление даты, а во втором - числовое. Чтобы макрос работал одинаково - сделайте идентичными эти листы. Еще добавлено: сделал 2-й файл - там принудительное преобразование к числовому выражению даты и просмотр с 4-го столбца - теперь отрабатывает на двух листах.
что данная формула отвечает за изменение (индек споискпоз)?
нет. Этот макрос открывает книгу,название которой находится в зеленой ячейке D1, которая находится в той же папке, что и текущая книга. ищет ФИО на одноименном листе в этой книге, и дату - и, если находит - подставляет уже готовые значения И ЗАЛИВКУ в столбцы "С-Н" Таким образом необходимость в формуле - и ее изменении отпадает.
Возможно ли вшить перечень листов в код, а кнопку перенести на лист доп.данные?
для этого замените [vba]
Код
ActiveWindow.SelectedSheets
[/vba] на [vba]
Код
Sheets(Array("Магазин №1", "Магазин №2"))
[/vba] Добавлено Почему у вас в магазине 1 и магазине 2 - разная структура и формулы? Данные начинаются с 4-го столбца, а не с 10-го - но это полбеды Формулы в одном листе - возвращают текстовое представление даты, а во втором - числовое. Чтобы макрос работал одинаково - сделайте идентичными эти листы. Еще добавлено: сделал 2-й файл - там принудительное преобразование к числовому выражению даты и просмотр с 4-го столбца - теперь отрабатывает на двух листах.SLAVICK
SLAVICK, не знаю как Вас и благодарить. Тестирование пройдено успешно! Но вот пытаясь интегрировать в рабочий документ, получаю ошибку : Run-time error '9': Subscript out of range
в Sheets(Array("Магазин №1", "Магазин №2")) я прописал около 20 магазинов(в кавычках и через запятую). Имеет ли значение очередность листов у сравниваемых файлов?
SLAVICK, не знаю как Вас и благодарить. Тестирование пройдено успешно! Но вот пытаясь интегрировать в рабочий документ, получаю ошибку : Run-time error '9': Subscript out of range
в Sheets(Array("Магазин №1", "Магазин №2")) я прописал около 20 магазинов(в кавычках и через запятую). Имеет ли значение очередность листов у сравниваемых файлов?EvgeniyVS
А во всех листах в ячейке Д1 имеется название книги? Смотрите пошагово на каком листе спотыкается. Возможно у вас в новой книге какие-то листы названы по другому.
А во всех листах в ячейке Д1 имеется название книги? Смотрите пошагово на каком листе спотыкается. Возможно у вас в новой книге какие-то листы названы по другому.SLAVICK
А во всех листах в ячейке Д1 имеется название книги?
-Да
Цитата
Смотрите пошагово на каком листе спотыкается.
-После запуска функции, тормозит на этой строке: Код For Each mSh In Sheets(Array("Магазин 1", "и т.д.")) 'ActiveWindow.SelectedSheets Попробовал применить Ваш код без указания листов, код стартует и заканчивается, но ничего не подтягивает.
Цитата
Возможно у вас в новой книге какие-то листы названы по другому.
Не думаю. Мы дублируем документ создавая новый месяц.
SLAVICK,
Цитата
А во всех листах в ячейке Д1 имеется название книги?
-Да
Цитата
Смотрите пошагово на каком листе спотыкается.
-После запуска функции, тормозит на этой строке: Код For Each mSh In Sheets(Array("Магазин 1", "и т.д.")) 'ActiveWindow.SelectedSheets Попробовал применить Ваш код без указания листов, код стартует и заканчивается, но ничего не подтягивает.
Цитата
Возможно у вас в новой книге какие-то листы названы по другому.
Не думаю. Мы дублируем документ создавая новый месяц.EvgeniyVS
скорее всего какой-то из листов назван не верно, может пробел лишний или еще что. Начните с одного - и добавляйте по одному - тогда будет понятно. Или ложите сюда файлы - со всеми листами - можно без заполненных др. данных.
скорее всего какой-то из листов назван не верно, может пробел лишний или еще что. Начните с одного - и добавляйте по одному - тогда будет понятно. Или ложите сюда файлы - со всеми листами - можно без заполненных др. данных.SLAVICK
скорее всего какой-то из листов назван не верно, может пробел лишний или еще что. Начните с одного - и добавляйте по одному - тогда будет понятно.
Вы были правы! Не знаю, что конкретно вызывало ошибку, но после того, как я прошелся по каждому листу, ошибка исчезла. Спасибо!
У меня еще один вопрос: А Ваш код, он сканирует весь столбец с фамилиями? Если да, можно ли его ограничить областью (B8:B27)? Также можно указать и область часов работы = (J7:AN26). Если конечно, это позволит снизить нагрузку. При старте макроса, exel висит около минуты.
SLAVICK,
Цитата
скорее всего какой-то из листов назван не верно, может пробел лишний или еще что. Начните с одного - и добавляйте по одному - тогда будет понятно.
Вы были правы! Не знаю, что конкретно вызывало ошибку, но после того, как я прошелся по каждому листу, ошибка исчезла. Спасибо!
У меня еще один вопрос: А Ваш код, он сканирует весь столбец с фамилиями? Если да, можно ли его ограничить областью (B8:B27)? Также можно указать и область часов работы = (J7:AN26). Если конечно, это позволит снизить нагрузку. При старте макроса, exel висит около минуты.EvgeniyVS
я и не пытался его оптимизировать - чтоб работал быстрее - нужно поиски в массивах делать и копировать форматы на диапазон сразу - а не в каждую ячейку отдельно. Это еще большой кусок работы и мне лениво этим заниматся. Тем более вам нужно его запускать раз в месяц - можно и подождать пару минут - чаю попить.
я и не пытался его оптимизировать - чтоб работал быстрее - нужно поиски в массивах делать и копировать форматы на диапазон сразу - а не в каждую ячейку отдельно. Это еще большой кусок работы и мне лениво этим заниматся. Тем более вам нужно его запускать раз в месяц - можно и подождать пару минут - чаю попить.SLAVICK
SLAVICK, Добрый день. Снова нуждаюсь в Вашей помощи) Можно ли внести изменения в код, чтобы заполнялись только столбцы имеющие дату в 6-ой строке ?
SLAVICK, Добрый день. Снова нуждаюсь в Вашей помощи) Можно ли внести изменения в код, чтобы заполнялись только столбцы имеющие дату в 6-ой строке ?EvgeniyVS
Хммм, значит я неверно интегрировал Ваш код. В связи с тем, что в апреле требовалось заполнить всех столбцов, я сразу не заметил возможный сбой. Это не критично. Но вопрос открыт, если он не видит дату, откуда он берет инфу?
Цитата
не видно ни номеров строк ни названия столбцов
Еще один вопрос: При запуске макроса, файл из которого подтягивается информация, имеет связи с другим файлом. Таким образом, каждое открытие файла (зависит от количества листов в исходной книге ~20), сопровождается уведомлением о необходимости "обновить" или "не обновлять" связи. Отойти (
Цитата
чаю попить.
) на время работы макроса к сожалению невозможно. Может, что-то посоветуете?
SLAVICK,
Цитата
так макрос так и работает.
Хммм, значит я неверно интегрировал Ваш код. В связи с тем, что в апреле требовалось заполнить всех столбцов, я сразу не заметил возможный сбой. Это не критично. Но вопрос открыт, если он не видит дату, откуда он берет инфу?
Цитата
не видно ни номеров строк ни названия столбцов
Еще один вопрос: При запуске макроса, файл из которого подтягивается информация, имеет связи с другим файлом. Таким образом, каждое открытие файла (зависит от количества листов в исходной книге ~20), сопровождается уведомлением о необходимости "обновить" или "не обновлять" связи. Отойти (
Цитата
чаю попить.
) на время работы макроса к сожалению невозможно. Может, что-то посоветуете?EvgeniyVS
со строки с ФИО, и с пустым столбцом в датах. Добавил проверку заполненности ячейки: [vba]
Код
If Len(StrCo) > 4 Then
[/vba] Теперь будет искать только если ячейка заполнена.: [vba]
Код
Sub FindValues_WithColors() Dim Wb As Workbook Dim mSh As Worksheet, Sh As Worksheet Dim i&, ii&, StrRo, StrCo, iT&, iiT&
For Each mSh In Sheets(Array("Магазин №1", "Магазин №2")) 'ActiveWindow.SelectedSheets mSh.Select Set Wb = Workbooks.Open(ActiveWorkbook.Path & "\" & mSh.Range("d1").Value, 0) Set Sh = Wb.Sheets(mSh.Name) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 7 To mSh.UsedRange.Rows.Count If Len(mSh.Cells(i, 2)) = 0 Then Exit For StrRo = mSh.Cells(i, 2) For ii = 3 To 8 StrCo = mSh.Cells(6, ii) If Len(StrCo) Then For iT = 7 To Sh.UsedRange.Rows.Count For iiT = 4 To 50 If StrRo = Sh.Cells(iT, 2) And Val(StrCo) = Val(Sh.Cells(1, iiT)) Then mSh.Cells(i, ii).Value = Sh.Cells(iT, iiT).Value mSh.Cells(i, ii).Interior.Color = Sh.Cells(iT, iiT).Interior.Color Exit For End If Next Next End If Next Next Wb.Close False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
со строки с ФИО, и с пустым столбцом в датах. Добавил проверку заполненности ячейки: [vba]
Код
If Len(StrCo) > 4 Then
[/vba] Теперь будет искать только если ячейка заполнена.: [vba]
Код
Sub FindValues_WithColors() Dim Wb As Workbook Dim mSh As Worksheet, Sh As Worksheet Dim i&, ii&, StrRo, StrCo, iT&, iiT&
For Each mSh In Sheets(Array("Магазин №1", "Магазин №2")) 'ActiveWindow.SelectedSheets mSh.Select Set Wb = Workbooks.Open(ActiveWorkbook.Path & "\" & mSh.Range("d1").Value, 0) Set Sh = Wb.Sheets(mSh.Name) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 7 To mSh.UsedRange.Rows.Count If Len(mSh.Cells(i, 2)) = 0 Then Exit For StrRo = mSh.Cells(i, 2) For ii = 3 To 8 StrCo = mSh.Cells(6, ii) If Len(StrCo) Then For iT = 7 To Sh.UsedRange.Rows.Count For iiT = 4 To 50 If StrRo = Sh.Cells(iT, 2) And Val(StrCo) = Val(Sh.Cells(1, iiT)) Then mSh.Cells(i, ii).Value = Sh.Cells(iT, iiT).Value mSh.Cells(i, ii).Interior.Color = Sh.Cells(iT, iiT).Interior.Color Exit For End If Next Next End If Next Next Wb.Close False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub