Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Создание отчета на дату СЕГОДНЯ - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание отчета на дату СЕГОДНЯ (Макросы/Sub)
Создание отчета на дату СЕГОДНЯ
parovoznik Дата: Понедельник, 25.04.2016, 12:08 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 116
Репутация: 4 ±
Замечаний: 0% ±

Excel 2007
Добрый день.
Есть лист "реестр" . Нужно при помощи макроса сформировать отчет за дату СЕГОДНЯ(25.04).Можно внести коррективы в макрос.Спасибо.
К сообщению приложен файл: ___.xlsm(22Kb)
 
Ответить
СообщениеДобрый день.
Есть лист "реестр" . Нужно при помощи макроса сформировать отчет за дату СЕГОДНЯ(25.04).Можно внести коррективы в макрос.Спасибо.

Автор - parovoznik
Дата добавления - 25.04.2016 в 12:08
Roman777 Дата: Понедельник, 25.04.2016, 13:36 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 700
Репутация: 75 ±
Замечаний: 20% ±

Excel 2007, Excel 2013
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) тут скрытые ячейки тоже считаются...
К сообщению приложен файл: 6010820.xlsm(23Kb)


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Понедельник, 25.04.2016, 16:31
 
Ответить
Сообщение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
Дата добавления - 25.04.2016 в 13:36
parovoznik Дата: Понедельник, 25.04.2016, 15:08 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 116
Репутация: 4 ±
Замечаний: 0% ±

Excel 2007
Roman777, спасибо .Все работает
 
Ответить
СообщениеRoman777, спасибо .Все работает

Автор - parovoznik
Дата добавления - 25.04.2016 в 15:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание отчета на дату СЕГОДНЯ (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!