Всем привет. Ребята, помогите пожалуйста макросом. Есть два документа, один из них "МЕСЯЦ" в который будут данные попадать с 40 разных документов (40 регионов) за 1 месяц. Второй "ОБЩИЙ" где по листочкам собраны все регионы на разных листах и там данные раскиданы по месяцам на каждом листе региона. Нужен макрос который будет искать в документе ОБЩИЙ лист с именем как в документе МЕСЯЦ в строке1 подписаны регионы, потом найдя нужны лист, будет искать дату которая указана в МЕСЯЦ в А1, и вставлять ЗНАЧЕНИЯ согласно названиям статей, при этом проверять их на совпадение по статьям (столбик А), для примера в документе ОБЩИЙ на листе РЕГИОН5 выделил оранжевым "статья4-5" которой нет во всех остальных листах, вот в при вставке в этот лист нужно чтоб если этой статьи нет в документе МЕСЯЦ то её пропустить, а все остальные данные вставить. Файлы в приложении... Заранее благодарен за помощь!
Всем привет. Ребята, помогите пожалуйста макросом. Есть два документа, один из них "МЕСЯЦ" в который будут данные попадать с 40 разных документов (40 регионов) за 1 месяц. Второй "ОБЩИЙ" где по листочкам собраны все регионы на разных листах и там данные раскиданы по месяцам на каждом листе региона. Нужен макрос который будет искать в документе ОБЩИЙ лист с именем как в документе МЕСЯЦ в строке1 подписаны регионы, потом найдя нужны лист, будет искать дату которая указана в МЕСЯЦ в А1, и вставлять ЗНАЧЕНИЯ согласно названиям статей, при этом проверять их на совпадение по статьям (столбик А), для примера в документе ОБЩИЙ на листе РЕГИОН5 выделил оранжевым "статья4-5" которой нет во всех остальных листах, вот в при вставке в этот лист нужно чтоб если этой статьи нет в документе МЕСЯЦ то её пропустить, а все остальные данные вставить. Файлы в приложении... Заранее благодарен за помощь!DJ_Marker_MC
Экий Вы Вот макросец, положите его в стандартный модуль книги "Месяц". Оба файла д.б. открыты [vba]
Code
Sub ertert() Dim j&, r$, rng As Range: Set rng = Range("A1").CurrentRegion On Error Resume Next With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count r = "[Общий.xlsx]" & rng(1, j).Value & "!" With .Sheets(rng(1, j).Value) With .Range("A1").CurrentRegion rng.Columns(j).Offset(1).Resize(rng.Rows.Count - 1).FormulaR1C1 = _ "=VLOOKUP(RC[-" & j - 1 & "]," & r & .Address(, , xlR1C1) & _ ",MATCH(R1C1," & r & .Rows(1).Address(, , xlR1C1) & ",0),0)" End With End With Next j End With With rng .SpecialCells(xlCellTypeFormulas, 16).ClearContents: .Value = .Value End With End Sub
[/vba] так проще?
Экий Вы Вот макросец, положите его в стандартный модуль книги "Месяц". Оба файла д.б. открыты [vba]
Code
Sub ertert() Dim j&, r$, rng As Range: Set rng = Range("A1").CurrentRegion On Error Resume Next With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count r = "[Общий.xlsx]" & rng(1, j).Value & "!" With .Sheets(rng(1, j).Value) With .Range("A1").CurrentRegion rng.Columns(j).Offset(1).Resize(rng.Rows.Count - 1).FormulaR1C1 = _ "=VLOOKUP(RC[-" & j - 1 & "]," & r & .Address(, , xlR1C1) & _ ",MATCH(R1C1," & r & .Rows(1).Address(, , xlR1C1) & ",0),0)" End With End With Next j End With With rng .SpecialCells(xlCellTypeFormulas, 16).ClearContents: .Value = .Value End With End Sub
что то не то. Открыл два файла, в файле месяц создал Модуль, туда вкинул Ваш код, потом запускаю его, но он ничего никуда не разносит, а только превращает в "0" все значения в файле месяц.
что то не то. Открыл два файла, в файле месяц создал Модуль, туда вкинул Ваш код, потом запускаю его, но он ничего никуда не разносит, а только превращает в "0" все значения в файле месяц.DJ_Marker_MC
Как вариант алгоритма - будет эффективен, если один файл "Общий" и много файлов "МЕСЯЦ", хотя и содним тоже вполне можно использовать, т.к. хоть и есть лишние действия, но зато простой код. Значит так, 1. цикл по всем листам "Общий", данные каждого через массив (чтоб быстрее) заносим в словарь. Ключ регион|статья|дата, item значение ячейки. 2. аналогичный цикл по одному листу "МЕСЯЦ" - но теперь уже из словаря извлекаем данные по ключу регион|статья|дата. 3. естественно те статьи, которых нет в "МЕСЯЦ"е, останутся неизвлечёнными. Но если нужно такие выловить - это несложно: ставим в словаре пометки найденным, в конце циклом делаем ревизию этих пометок.
Если файлов "МЕСЯЦ" много, то будет эффективно, т.к. можно один раз набрать данные в словарь, затем заполнить в цикле все "МЕСЯЦ"ы.
Как вариант алгоритма - будет эффективен, если один файл "Общий" и много файлов "МЕСЯЦ", хотя и содним тоже вполне можно использовать, т.к. хоть и есть лишние действия, но зато простой код. Значит так, 1. цикл по всем листам "Общий", данные каждого через массив (чтоб быстрее) заносим в словарь. Ключ регион|статья|дата, item значение ячейки. 2. аналогичный цикл по одному листу "МЕСЯЦ" - но теперь уже из словаря извлекаем данные по ключу регион|статья|дата. 3. естественно те статьи, которых нет в "МЕСЯЦ"е, останутся неизвлечёнными. Но если нужно такие выловить - это несложно: ставим в словаре пометки найденным, в конце циклом делаем ревизию этих пометок.
Если файлов "МЕСЯЦ" много, то будет эффективно, т.к. можно один раз набрать данные в словарь, затем заполнить в цикле все "МЕСЯЦ"ы.Hugo
ааай))) не так... Вы немножко неправильно поняли))) мне нужно наоборот что с месяца разносило в общий по листам находя нужную дату и нужную строку. А у вас оно ищет в общем сводит в месяц))))
ааай))) не так... Вы немножко неправильно поняли))) мне нужно наоборот что с месяца разносило в общий по листам находя нужную дату и нужную строку. А у вас оно ищет в общем сводит в месяц))))DJ_Marker_MC
Hugo, если честно совсем ничего не понял. Файл месяц 1 и файл общий тоже один. Просто в файл месяц данные будут собираться формулой с 40-50 однотипных документов за один месяц, после того как файл месяц будет готов, нужно разнести с этого файла в общий в нужны листы и в нужный месяц значения макросом, чтоб не делать это вручную - "скопировать, вставить значения"
Hugo, если честно совсем ничего не понял. Файл месяц 1 и файл общий тоже один. Просто в файл месяц данные будут собираться формулой с 40-50 однотипных документов за один месяц, после того как файл месяц будет готов, нужно разнести с этого файла в общий в нужны листы и в нужный месяц значения макросом, чтоб не делать это вручную - "скопировать, вставить значения"DJ_Marker_MC
Ну раз не поняли, то и ладно... Решение уже есть, его думаю несложно повернуть наоборот. Мой алгоритм тоже без проблем переворачиватеся - собираем в словарь циклом по ячейкам одного листа, раскладываем из словаря циклом по многим листам. но вот писать код некогда, извините. Да и решение уже есть, ничуть не хуже, просто другое.
Ну раз не поняли, то и ладно... Решение уже есть, его думаю несложно повернуть наоборот. Мой алгоритм тоже без проблем переворачиватеся - собираем в словарь циклом по ячейкам одного листа, раскладываем из словаря циклом по многим листам. но вот писать код некогда, извините. Да и решение уже есть, ничуть не хуже, просто другое.Hugo
Hugo, если для Вас это НИЧЕГО СЛОЖНОГО, то это вовсе не значит что для других также. Я не умею писать макросы к сожалению и для меня развернуть этот код в обратном порядке - проблема, если бы для меня это не было проблемой я б не просил помощи, но перед тем как попросить тут помощь я перерыл гугл и только потом обратился за помощью. Надеюсь найдутся добрые люди.
Hugo, если для Вас это НИЧЕГО СЛОЖНОГО, то это вовсе не значит что для других также. Я не умею писать макросы к сожалению и для меня развернуть этот код в обратном порядке - проблема, если бы для меня это не было проблемой я б не просил помощи, но перед тем как попросить тут помощь я перерыл гугл и только потом обратился за помощью. Надеюсь найдутся добрые люди.DJ_Marker_MC
Сообщение отредактировал marker_mc - Вторник, 30.10.2012, 17:35
Ну я ведь не заставляю Вас писать код Я дал совет/идею/направление, если бы сидел без дела - написал бы код. Может кто другой реализует в качестве тренировки или от скуки.
Ну или считайте, что это я для себя памятку написал, как делать - чтоб потом, когда будет время, заново не выдумывать
Ну я ведь не заставляю Вас писать код Я дал совет/идею/направление, если бы сидел без дела - написал бы код. Может кто другой реализует в качестве тренировки или от скуки.
Ну или считайте, что это я для себя памятку написал, как делать - чтоб потом, когда будет время, заново не выдумывать Hugo
Ну, marker_mc ... Зеленая кнопка собирает в одном направлении, сиреневая разбивает в другом направлении. Не попутайте цвета Оба макроса в одном стиле. Оба файла д.б. открыты [vba]
Code
Sub rtyrty() 'сиреневая кнопка Dim i&, j&, r$, rng As Range Application.ScreenUpdating = False Set rng = Range("A1").CurrentRegion r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1) 'или так 'r = "[месяц.xlsm]" & ActiveSheet.Name & "!" & rng.Address(, , xlR1C1) On Error Resume Next: Err.Clear With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count With .Sheets(rng(1, j).Value) i = .Rows(1).Find(rng(1, 1).Value, lookat:=xlWhole).Column If Err = 0 Then With .Range("A1").CurrentRegion With .Columns(i).Offset(1).Resize(.Rows.Count - 1) .FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-" & i - 1 & "]," & r & "," & j & ",0),"""")" .Value = .Value End With End With Else Err.Clear End If End With Next j End With Application.ScreenUpdating = True End Sub
[/vba] Немного переделал код. Старый вариант тоже будет работать, но новый правильнее.
Ну, marker_mc ... Зеленая кнопка собирает в одном направлении, сиреневая разбивает в другом направлении. Не попутайте цвета Оба макроса в одном стиле. Оба файла д.б. открыты [vba]
Code
Sub rtyrty() 'сиреневая кнопка Dim i&, j&, r$, rng As Range Application.ScreenUpdating = False Set rng = Range("A1").CurrentRegion r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1) 'или так 'r = "[месяц.xlsm]" & ActiveSheet.Name & "!" & rng.Address(, , xlR1C1) On Error Resume Next: Err.Clear With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count With .Sheets(rng(1, j).Value) i = .Rows(1).Find(rng(1, 1).Value, lookat:=xlWhole).Column If Err = 0 Then With .Range("A1").CurrentRegion With .Columns(i).Offset(1).Resize(.Rows.Count - 1) .FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-" & i - 1 & "]," & r & "," & j & ",0),"""")" .Value = .Value End With End With Else Err.Clear End If End With Next j End With Application.ScreenUpdating = True End Sub
[/vba] Немного переделал код. Старый вариант тоже будет работать, но новый правильнее.nilem
Sub rtyrty() 'сиреневая кнопка Dim i&, j&, r$, rng As Range Application.ScreenUpdating = False Set rng = Range("A1").CurrentRegion.Offset(, 1) 'смещаем rng на 1 столбец вправо, т.е. в кач-ве идентификаторов 'у нас будут не 1, 2, 3 из ст. А, а статья1, статья2 из ст. В r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1) 'или так 'r = "[месяц.xlsm]" & ActiveSheet.Name & "!" & rng.Address(, , xlR1C1) On Error Resume Next With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count With .Sheets(rng(2, j).Value) 'rng(2, j).Value - это Регион1, Регион2, и т.д. 'на листе Регион1 (2 ,3 ...) ищем дату из В1 во 2-й строке; i - это номер столбца i = .Rows(2).Find(rng(1, 1).Value, lookat:=xlWhole).Column If i > 0 Then With .Range("A1").CurrentRegion 'в найденном столбце пишем формулу типа =ЕСЛИОШИБКА(ВПР(статья1;rng.Address;столбец;0);"") With .Columns(i).Offset(2).Resize(.Rows.Count - 2) .FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-" & i - 2 & "]," & r & "," & j & ",0),"""")" 'вместо формул оставляем значения .Value = .Value End With End With End If End With Next j End With Application.ScreenUpdating = True End Sub
[/vba] Найди 6 отличий и получи приз!
как просили: [vba]
Code
Sub rtyrty() 'сиреневая кнопка Dim i&, j&, r$, rng As Range Application.ScreenUpdating = False Set rng = Range("A1").CurrentRegion.Offset(, 1) 'смещаем rng на 1 столбец вправо, т.е. в кач-ве идентификаторов 'у нас будут не 1, 2, 3 из ст. А, а статья1, статья2 из ст. В r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1) 'или так 'r = "[месяц.xlsm]" & ActiveSheet.Name & "!" & rng.Address(, , xlR1C1) On Error Resume Next With Workbooks("Общий.xlsx") For j = 2 To rng.Columns.Count With .Sheets(rng(2, j).Value) 'rng(2, j).Value - это Регион1, Регион2, и т.д. 'на листе Регион1 (2 ,3 ...) ищем дату из В1 во 2-й строке; i - это номер столбца i = .Rows(2).Find(rng(1, 1).Value, lookat:=xlWhole).Column If i > 0 Then With .Range("A1").CurrentRegion 'в найденном столбце пишем формулу типа =ЕСЛИОШИБКА(ВПР(статья1;rng.Address;столбец;0);"") With .Columns(i).Offset(2).Resize(.Rows.Count - 2) .FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-" & i - 2 & "]," & r & "," & j & ",0),"""")" 'вместо формул оставляем значения .Value = .Value End With End With End If End With Next j End With Application.ScreenUpdating = True End Sub
Еще раз спасибо. Всё работает как часы. С описанием посижу поразбираюсь, очень хочу понять как всё работает. Можете еще только один момент объяснить:
r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1)
"[месяц.xlsm]макрос!" - это что док месяц, лист макрос далее должен идти диапазон rng.Address(, , xlR1C1), а rng = Range("A1").CurrentRegion.Offset(, 1) тоесть r = "[месяц.xlsm]макрос!" & Range("A1").CurrentRegion.Offset(, 1).Address(, , xlR1C1) вот я никак не могу понять эту часть((( Расшифруйте пожалуйста
Еще раз спасибо. Всё работает как часы. С описанием посижу поразбираюсь, очень хочу понять как всё работает. Можете еще только один момент объяснить:
r = "[месяц.xlsm]макрос!" & rng.Address(, , xlR1C1)
"[месяц.xlsm]макрос!" - это что док месяц, лист макрос далее должен идти диапазон rng.Address(, , xlR1C1), а rng = Range("A1").CurrentRegion.Offset(, 1) тоесть r = "[месяц.xlsm]макрос!" & Range("A1").CurrentRegion.Offset(, 1).Address(, , xlR1C1) вот я никак не могу понять эту часть((( Расшифруйте пожалуйстаDJ_Marker_MC
О... спасибо. теперь дошло)))) Я даже кое что подправил под себя)))
.Resize(.Rows.Count - 3)
у Вас там стоит 2 и если поставить внизу обоих таблиц формулу суммы, то значения заменяются или значениями или пустотой в случае если столбце B не ставить наименование итоговой строки, а при -3 всё ок)))
О... спасибо. теперь дошло)))) Я даже кое что подправил под себя)))
.Resize(.Rows.Count - 3)
у Вас там стоит 2 и если поставить внизу обоих таблиц формулу суммы, то значения заменяются или значениями или пустотой в случае если столбце B не ставить наименование итоговой строки, а при -3 всё ок)))DJ_Marker_MC
With .Columns(i).Offset(2).Resize(.Rows.Count - 2)
[/vba]
я хочу в Offset вместо 2, вставить формулу поискпоз чтоб смещение происходило не на указанное число 2, а на найденную позицию минус 1, как я понимаю должно быть так:
[vba]
Code
With .Columns(i).Offset(WorksheetFunction.Match("18", Range("A1:A100"), 0) - 1).Resize(.Rows.Count - 2)
[/vba]
но почему то таким образом ничего не происходит? Другими словами мне нужно вернуть номер строки текущего листа с помощью вот этого выражения WorksheetFunction.Match("18", Range("A1:A100"), 0) - 1 но почему то оно не равносильно этому Offset(2), что я сделал в этом случае не правильно?
Ребята, помогите пожалуйста немножко реконструировать одну формулу в VBA в том что уже готово.
With .Columns(i).Offset(2).Resize(.Rows.Count - 2)
[/vba]
я хочу в Offset вместо 2, вставить формулу поискпоз чтоб смещение происходило не на указанное число 2, а на найденную позицию минус 1, как я понимаю должно быть так:
[vba]
Code
With .Columns(i).Offset(WorksheetFunction.Match("18", Range("A1:A100"), 0) - 1).Resize(.Rows.Count - 2)
[/vba]
но почему то таким образом ничего не происходит? Другими словами мне нужно вернуть номер строки текущего листа с помощью вот этого выражения WorksheetFunction.Match("18", Range("A1:A100"), 0) - 1 но почему то оно не равносильно этому Offset(2), что я сделал в этом случае не правильно?DJ_Marker_MC
Сообщение отредактировал marker_mc - Вторник, 06.11.2012, 14:11
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
