Добрый вечер. Прошу помощи в решении задачи. Необходимо объединить листы (1-31) А1:G15 в один сводный лист в этой книге. В интернете нашла макрос, но он в моем случае не подходит, тк объединяет все листы книги. В макросах не сильна совсем.
Добрый вечер. Прошу помощи в решении задачи. Необходимо объединить листы (1-31) А1:G15 в один сводный лист в этой книге. В интернете нашла макрос, но он в моем случае не подходит, тк объединяет все листы книги. В макросах не сильна совсем.GGR
Тут думаю Вы заблуждаетесь. Набросал вариант, как понял. Дублирующий столбец норма в середине таблицы убрал - думаю он ненужен. Хотя всегда можно вернуть его назад.
Тут думаю Вы заблуждаетесь. Набросал вариант, как понял. Дублирующий столбец норма в середине таблицы убрал - думаю он ненужен. Хотя всегда можно вернуть его назад.DrMini
cmivadwot, DrMini, Доброе утро. Очень извиняюсь , что вела вас в заблуждение. Мне надо было просто собрать данные с листов ( всех вводимых по дням) в итоговый. Пример как должно быть прилагаю (лист "ИТОГ"). Макрос сбор листов в один итоговый есть , но он мне не подходит ,тк у меня есть еще листы(база и свод). Макрос объединяет все листы.
cmivadwot, DrMini, Доброе утро. Очень извиняюсь , что вела вас в заблуждение. Мне надо было просто собрать данные с листов ( всех вводимых по дням) в итоговый. Пример как должно быть прилагаю (лист "ИТОГ"). Макрос сбор листов в один итоговый есть , но он мне не подходит ,тк у меня есть еще листы(база и свод). Макрос объединяет все листы.GGR
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(u, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets(u).Range("a3:g" & a + 2).Copy Sheets("ИТОГ").Range("a" & b) End If Next Application.ScreenUpdating = True End Sub
[/vba]
апдэйт ну и формулами поприколу в файле .xlsx
[vba]
Код
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(u, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 1 Sheets(u).Range("a3:g" & a + 2).Copy Sheets("ИТОГ").Range("a" & b) End If Next Application.ScreenUpdating = True End Sub
[/vba]
апдэйт ну и формулами поприколу в файле .xlsxNic70y
GGR, не обратил внимания, что у Вас там формула, вариант (1001.xlsm) [vba]
Код
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(32, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 2 Sheets("ИТОГ").Range("a" & b & ":g" & b + a - 1) = Sheets(u).Range("a3:g" & a + 2).Value End If Next Application.ScreenUpdating = True End Sub
[/vba] или изменить формулу (2002.xlsm)
Код
=СЧЁТЕСЛИМН(B3:B10;"*";A3:A10;A3)
[p.s.]обратите внимание, что макрос просматривает диапазон "a3:a12", если его нужно увеличить - 12 замените на максимально возможное в пределах разумного[/p.s.]
GGR, не обратил внимания, что у Вас там формула, вариант (1001.xlsm) [vba]
Код
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(32, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 2 Sheets("ИТОГ").Range("a" & b & ":g" & b + a - 1) = Sheets(u).Range("a3:g" & a + 2).Value End If Next Application.ScreenUpdating = True End Sub
[/vba] или изменить формулу (2002.xlsm)
Код
=СЧЁТЕСЛИМН(B3:B10;"*";A3:A10;A3)
[p.s.]обратите внимание, что макрос просматривает диапазон "a3:a12", если его нужно увеличить - 12 замените на максимально возможное в пределах разумного[/p.s.]Nic70y
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(32, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "c").End(xlUp).Row + 2 Sheets("ИТОГ").Range("a" & b & ":g" & b + a - 1) = Sheets(u).Range("a3:g" & a + 2).Value c = Sheets(u).Cells(Rows.Count, "b").End(xlUp).Row Sheets("ИТОГ").Range("b" & b + a & ":d" & b + a) = Sheets(u).Range("b" & c & ":d" & c).Value End If Next Application.ScreenUpdating = True End Sub
Sub u_727() Application.ScreenUpdating = False c = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row If c > 2 Then Sheets("ИТОГ").Range("a3:g" & c).Clear For u = 4 To Sheets.Count a = Application.Match(32, Sheets(u).Range("a3:a12"), 1) If IsNumeric(a) Then b = Sheets("ИТОГ").Cells(Rows.Count, "c").End(xlUp).Row + 2 Sheets("ИТОГ").Range("a" & b & ":g" & b + a - 1) = Sheets(u).Range("a3:g" & a + 2).Value c = Sheets(u).Cells(Rows.Count, "b").End(xlUp).Row Sheets("ИТОГ").Range("b" & b + a & ":d" & b + a) = Sheets(u).Range("b" & c & ":d" & c).Value End If Next Application.ScreenUpdating = True End Sub
GGR, ну во первых при добавлении листа нужно изменить начало цикла (хотя конечно в данном случае это не повлияло, но все равно надо) во вторых я конечно забыл изменить удаление старых данных в третьих: что делать со строками, где напротив фио нет объема, с листами где только число в первой* ячейке?
пока так (файл)
GGR, ну во первых при добавлении листа нужно изменить начало цикла (хотя конечно в данном случае это не повлияло, но все равно надо) во вторых я конечно забыл изменить удаление старых данных в третьих: что делать со строками, где напротив фио нет объема, с листами где только число в первой* ячейке?
Nic70y, по поводу строк напротив ФИО где нет объемов, - численность не считать. ( пример в дата за 7 число) ФИО стоят - объемов нет. Если участников н-р на объем стоит только в 1 строке , расчет идет не верный.( считает только 1 человека) пример дата за 6 число. Есть листы в которых нет ФИО и объема- только дата в первой ячейке- пусть они выходят нулевыми ( как сейчас в примере). Во вкладке " расчет" формула очень большая, из-за этого не смогла прописать условие , чтобы округляла до 2 знаков и не выходило ЗНАЧ.Как то можно упростить условие?
Nic70y, по поводу строк напротив ФИО где нет объемов, - численность не считать. ( пример в дата за 7 число) ФИО стоят - объемов нет. Если участников н-р на объем стоит только в 1 строке , расчет идет не верный.( считает только 1 человека) пример дата за 6 число. Есть листы в которых нет ФИО и объема- только дата в первой ячейке- пусть они выходят нулевыми ( как сейчас в примере). Во вкладке " расчет" формула очень большая, из-за этого не смогла прописать условие , чтобы округляла до 2 знаков и не выходило ЗНАЧ.Как то можно упростить условие?GGR