Добрый день. Есть лист "реестр" . Нужно при помощи макроса сформировать отчет за дату СЕГОДНЯ(25.04).Можно внести коррективы в макрос.Спасибо.
Добрый день. Есть лист "реестр" . Нужно при помощи макроса сформировать отчет за дату СЕГОДНЯ(25.04).Можно внести коррективы в макрос.Спасибо.parovoznik
Sub Кнопка3_Щелчок() Dim i As Long, LastRow As Long, LR As Long LR = 5 ' начало отчета LastRow = Sheets("реестр").Cells(Rows.Count, 4).End(xlUp).Row 'Нашли последнюю строку на первом листе With Sheets("отчет") Range(.Cells(5, 1), .Cells(LastRow + 1, 2)).Clear 'Очистили диапазон отчета полностью .Cells(1, 2).ClearContents .Cells(1, 2) = "Отчет по состоянию на :" & Worksheets("реестр").Range("G1") For i = 1 To LastRow If Worksheets("реестр").Range("G1").Value = Worksheets("реестр").Range("F" & i) Then .Cells(LR, 1) = Worksheets("реестр").Range("F" & i) .Cells(LR, 1).NumberFormat = "m/d/yyyy" .Cells(LR, 2) = Worksheets("реестр").Range("D" & i) .Cells(LR, 3) = Worksheets("реестр").Range("G" & i) LR = LR + 1 End If Next i 'Заполним подвал отчета .Cells(LR, 1) = "Итого:" .Cells(LR, 3) = Application.WorksheetFunction.Sum(Range(.Cells(5, 3), .Cells(LR - 1, 3))) 'Подсчет суммы Range(.Cells(5, 1), .Cells(LR, 3)).Borders.LineStyle = xlContinuous 'Сделали обрамление ячеек End With If LR = 5 Then MsgBox "По данными критериям данных не найдено.", 64, "Сообщение" ThisWorkbook.Worksheets("отчет").Activate End Sub
[/vba] лишнего тут оставил - исправился... У Вас скрытый столбец, когда Вы обращаетесь к Cells(x,y) тут скрытые ячейки тоже считаются...
parovoznik, так попробуйте... [vba]
Код
Sub Кнопка3_Щелчок() Dim i As Long, LastRow As Long, LR As Long LR = 5 ' начало отчета LastRow = Sheets("реестр").Cells(Rows.Count, 4).End(xlUp).Row 'Нашли последнюю строку на первом листе With Sheets("отчет") Range(.Cells(5, 1), .Cells(LastRow + 1, 2)).Clear 'Очистили диапазон отчета полностью .Cells(1, 2).ClearContents .Cells(1, 2) = "Отчет по состоянию на :" & Worksheets("реестр").Range("G1") For i = 1 To LastRow If Worksheets("реестр").Range("G1").Value = Worksheets("реестр").Range("F" & i) Then .Cells(LR, 1) = Worksheets("реестр").Range("F" & i) .Cells(LR, 1).NumberFormat = "m/d/yyyy" .Cells(LR, 2) = Worksheets("реестр").Range("D" & i) .Cells(LR, 3) = Worksheets("реестр").Range("G" & i) LR = LR + 1 End If Next i 'Заполним подвал отчета .Cells(LR, 1) = "Итого:" .Cells(LR, 3) = Application.WorksheetFunction.Sum(Range(.Cells(5, 3), .Cells(LR - 1, 3))) 'Подсчет суммы Range(.Cells(5, 1), .Cells(LR, 3)).Borders.LineStyle = xlContinuous 'Сделали обрамление ячеек End With If LR = 5 Then MsgBox "По данными критериям данных не найдено.", 64, "Сообщение" ThisWorkbook.Worksheets("отчет").Activate End Sub
[/vba] лишнего тут оставил - исправился... У Вас скрытый столбец, когда Вы обращаетесь к Cells(x,y) тут скрытые ячейки тоже считаются...Roman777