Есть желание выводить отчет по выбираемой дате с трех листов. В чем я вижу проблему что обозначить начало собираемой информации достаточно легко по столбцу А достаточно сравнить дату. Но как найти конец - маркером которого может выступать наверно следующий за ним маркер иной даты.
Что бы вы могли посоветовать это ближе к VBA, сводной таблице, или формулами ?
Собирать хочется со страниц: Овощи Мясо Бакалея. Выводить на страницу: Отчет.
Пользователь: 444 Администратор: 555
Здравствуйте.
Есть желание выводить отчет по выбираемой дате с трех листов. В чем я вижу проблему что обозначить начало собираемой информации достаточно легко по столбцу А достаточно сравнить дату. Но как найти конец - маркером которого может выступать наверно следующий за ним маркер иной даты.
Что бы вы могли посоветовать это ближе к VBA, сводной таблице, или формулами ?
Собирать хочется со страниц: Овощи Мясо Бакалея. Выводить на страницу: Отчет.
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") .Range("a2:i" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then lr = sh.Cells(Rows.Count, 2).End(xlUp).Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If sh.Range(aDat, "i" & lr).Copy .Sheets("Отчет").Range("a" & .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1) End If Next sh On Error Resume Next .Sheets("Отчет").ClearComments End With Application.EnableEvents = True End Sub
[/vba] Хотя, мне кажется, что удобнее и красивее, когда дата вписана напротив каждой строки с данными (смотрите 2-й файл).
koyaanisqatsi, посмотрите такой макрос: [vba]
Код
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") .Range("a2:i" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then lr = sh.Cells(Rows.Count, 2).End(xlUp).Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If sh.Range(aDat, "i" & lr).Copy .Sheets("Отчет").Range("a" & .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1) End If Next sh On Error Resume Next .Sheets("Отчет").ClearComments End With Application.EnableEvents = True End Sub
[/vba] Хотя, мне кажется, что удобнее и красивее, когда дата вписана напротив каждой строки с данными (смотрите 2-й файл).Manyasha
Manyasha, То что есть два варианта думаю это скорее хорошо. Под свои задачи кажется предпочтительнее первый вариант. Хочу минимализировать информацию на которую можно отвлечся и сконцентрировать на конкретных данных которые обязательны для ознакомления и выполнения. Смысла особого в отчете писать для каждой строки одну и ту же дату особого не вижу немного будет отвлекать при восприятии информации. В ту же очередь первый вариант хотя бы косвенно разграничивает принадлежность к складу информации. Отчетного слова то нет к какому складу относится ну да и ладно зато видно что снова появилась дата и видно что товар уже другой дума человеку легко будет догадаться где искать информацию которая относится непосредственно к его торговому направлению. А так Очень здорово. Первый вариант думаю более чем устроит. Как первый шаг для систематизации потока информации дума более чем ! Огромное спасибо.
Manyasha, То что есть два варианта думаю это скорее хорошо. Под свои задачи кажется предпочтительнее первый вариант. Хочу минимализировать информацию на которую можно отвлечся и сконцентрировать на конкретных данных которые обязательны для ознакомления и выполнения. Смысла особого в отчете писать для каждой строки одну и ту же дату особого не вижу немного будет отвлекать при восприятии информации. В ту же очередь первый вариант хотя бы косвенно разграничивает принадлежность к складу информации. Отчетного слова то нет к какому складу относится ну да и ладно зато видно что снова появилась дата и видно что товар уже другой дума человеку легко будет догадаться где искать информацию которая относится непосредственно к его торговому направлению. А так Очень здорово. Первый вариант думаю более чем устроит. Как первый шаг для систематизации потока информации дума более чем ! Огромное спасибо.koyaanisqatsi
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") 'Изменила здесь .Range("a2:l" & .UsedRange.Rows.Count + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then 'Изменила здесь lr = .Sheets("Отчет").UsedRange.Rows.Count + .Sheets("Отчет").UsedRange.Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If sh.Range(aDat, "l" & lr).Copy .Sheets("Отчет").Range("a" & .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1) End If Next sh On Error Resume Next 'Изменила здесь .Sheets("Отчет").UsedRange.ClearComments End With Application.EnableEvents = True End Sub
[/vba]
koyaanisqatsi, поправила: [vba]
Код
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") 'Изменила здесь .Range("a2:l" & .UsedRange.Rows.Count + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then 'Изменила здесь lr = .Sheets("Отчет").UsedRange.Rows.Count + .Sheets("Отчет").UsedRange.Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If sh.Range(aDat, "l" & lr).Copy .Sheets("Отчет").Range("a" & .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1) End If Next sh On Error Resume Next 'Изменила здесь .Sheets("Отчет").UsedRange.ClearComments End With Application.EnableEvents = True End Sub
Manyasha, Опять что то происходит удивительное. Вывожу отчет на 19.04.2016 и он цепляет два числа 17.04.2016 и 19.04.2016 но за 19 не выводит данные (
Manyasha, Опять что то происходит удивительное. Вывожу отчет на 19.04.2016 и он цепляет два числа 17.04.2016 и 19.04.2016 но за 19 не выводит данные (koyaanisqatsi
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh, x0& With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") .Range("a2:l" & .UsedRange.Rows.Count + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then
lr = sh.UsedRange.Rows.Count + .Sheets("Отчет").UsedRange.Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If 'Изменила здесь x0 = .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1 sh.Range(aDat, "l" & lr).Copy .Sheets("Отчет").Range("a" & x0) .Sheets("Отчет").Cells(x0, "n") = sh.Name'Дата выводится в столбец n End If Next sh On Error Resume Next .Sheets("Отчет").UsedRange.ClearComments End With Application.EnableEvents = True End Sub
[/vba]
koyaanisqatsi, можно:
[vba]
Код
Sub report() Application.ScreenUpdating = False Application.EnableEvents = False Dim datReport As Date, aDat As Range, lr&, lra As Range, sh, x0& With ThisWorkbook With .Sheets("Отчет") datReport = .Range("m2") .Range("a2:l" & .UsedRange.Rows.Count + 1).ClearContents End With For Each sh In Array(.Sheets(2), .Sheets(3), .Sheets(4)) Set aDat = sh.Columns(1).Find(datReport, , xlFormulas, xlWhole) If Not aDat Is Nothing Then Set lra = sh.Cells(Rows.Count, 1).End(xlUp) If aDat.Row = lra.Row Then
lr = sh.UsedRange.Rows.Count + .Sheets("Отчет").UsedRange.Row Else lr = sh.Range(aDat.Offset(1), lra).Find("*", , xlFormulas, xlWhole, xlByRows).Row - 1 End If 'Изменила здесь x0 = .Sheets("Отчет").Cells(Rows.Count, 2).End(xlUp).Row + 1 sh.Range(aDat, "l" & lr).Copy .Sheets("Отчет").Range("a" & x0) .Sheets("Отчет").Cells(x0, "n") = sh.Name'Дата выводится в столбец n End If Next sh On Error Resume Next .Sheets("Отчет").UsedRange.ClearComments End With Application.EnableEvents = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
