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

Вход

Регистрация

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

 

= Мир MS Excel/Возврат на лист предыдущего дня - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Возврат на лист предыдущего дня (Макросы/Sub)
Возврат на лист предыдущего дня
dmtgrs Дата: Вторник, 25.12.2018, 08:45 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте.
Помогите пожалуйста. Мне нужно чтобы макрос создавал лист с названием текущей даты и копировал определенные ячейки с листа с предыдущей датой.
Т.е. сегодня я нажимаю на макрос, он создает новый лист у которого название 25/12/2018 и затем он копирует определенные ячейки с листа 24/12/2018.
Как создать лист и переименовать его в текущую дату я понял, но затем макрос обращается к листу с конкретным названием, а нужно чтобы он обращался к листу со вчерашней датой.
К сообщению приложен файл: 0104676.xlsm(70.0 Kb)


Сообщение отредактировал dmtgrs - Вторник, 25.12.2018, 08:46
 
Ответить
СообщениеЗдравствуйте.
Помогите пожалуйста. Мне нужно чтобы макрос создавал лист с названием текущей даты и копировал определенные ячейки с листа с предыдущей датой.
Т.е. сегодня я нажимаю на макрос, он создает новый лист у которого название 25/12/2018 и затем он копирует определенные ячейки с листа 24/12/2018.
Как создать лист и переименовать его в текущую дату я понял, но затем макрос обращается к листу с конкретным названием, а нужно чтобы он обращался к листу со вчерашней датой.

Автор - dmtgrs
Дата добавления - 25.12.2018 в 08:45
sboy Дата: Вторник, 25.12.2018, 09:56 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2417
Репутация: 682 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Поправил немного
[vba]
Код
Sub НовыйДень()
'
' НовыйДень Макрос
'

'
    d = Date
    With Sheets((d - 1) & ""): arr = Range(.Cells(3, 8), .Cells(3, 8).End(xlDown)): End With
    Sheets.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Date 'Format(Now, "yyyy/mm/dd")
            Range("D3:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).ClearContents
            .Cells(3, 4).Resize(UBound(arr), 1) = arr
        End With
End Sub
[/vba]
К сообщению приложен файл: 0104676.xlsb(42.5 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
Поправил немного
[vba]
Код
Sub НовыйДень()
'
' НовыйДень Макрос
'

'
    d = Date
    With Sheets((d - 1) & ""): arr = Range(.Cells(3, 8), .Cells(3, 8).End(xlDown)): End With
    Sheets.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Date 'Format(Now, "yyyy/mm/dd")
            Range("D3:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).ClearContents
            .Cells(3, 4).Resize(UBound(arr), 1) = arr
        End With
End Sub
[/vba]

Автор - sboy
Дата добавления - 25.12.2018 в 09:56
_Boroda_ Дата: Вторник, 25.12.2018, 13:21 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14501
Репутация: 5789 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
dmtgrs, Вы каждый-каждый день работаете? Выходные и праздники тоже?
Предлагаю такой вариант (заодно проваряет наличие сегодняшнего листа)
[vba]
Код
Sub tt()
    On Error Resume Next
    aaa = Sheets(Date & "").Cells(1).Value
    If Err = 0 Then
        MsgBox "Лист ''" & Date & "'' уже есть"
        Exit Sub
    End If
    On Error GoTo 0
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Date
        r1_ = .Cells(.Rows.Count, 1).End(3).Row
        .Range("D3:D" & r1_) = .Range("H3:H" & r1_).Value
        .Range("E3:G" & r1_).ClearContents
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: 0104676_1.xlsm(70.2 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеdmtgrs, Вы каждый-каждый день работаете? Выходные и праздники тоже?
Предлагаю такой вариант (заодно проваряет наличие сегодняшнего листа)
[vba]
Код
Sub tt()
    On Error Resume Next
    aaa = Sheets(Date & "").Cells(1).Value
    If Err = 0 Then
        MsgBox "Лист ''" & Date & "'' уже есть"
        Exit Sub
    End If
    On Error GoTo 0
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Date
        r1_ = .Cells(.Rows.Count, 1).End(3).Row
        .Range("D3:D" & r1_) = .Range("H3:H" & r1_).Value
        .Range("E3:G" & r1_).ClearContents
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 25.12.2018 в 13:21
dmtgrs Дата: Вторник, 25.12.2018, 14:40 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Класс!!! Спасибо огромное!!! я тоже тут намучился, но что-то получилось, не знаю на сколько правильно)) То что у вас вылезает сообщение, для меня это вообще верх мастерства!!!

У меня так получилось, попробую разобраться как у вас так хитро сообщение вылетает
[vba]
Код
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Format(Now, "dd/mm/yyyy")
ActiveSheet.Previous.Select
Cells.Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("D3:G15000").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Previous.Select
Range("H3:H15000").Select
Selection.Copy
ActiveSheet.Next.Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Rows("1:3").Select
Range("A3").Activate
ActiveWindow.FreezePanes = True
Range("A2").Select
Selection.AutoFilter
Range("D1").Select
ActiveCell.Value = Format(Now, "dd.mm.yyyy")

End Sub
[/vba]


Сообщение отредактировал dmtgrs - Вторник, 25.12.2018, 14:56
 
Ответить
СообщениеКласс!!! Спасибо огромное!!! я тоже тут намучился, но что-то получилось, не знаю на сколько правильно)) То что у вас вылезает сообщение, для меня это вообще верх мастерства!!!

У меня так получилось, попробую разобраться как у вас так хитро сообщение вылетает
[vba]
Код
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Format(Now, "dd/mm/yyyy")
ActiveSheet.Previous.Select
Cells.Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("D3:G15000").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Previous.Select
Range("H3:H15000").Select
Selection.Copy
ActiveSheet.Next.Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Rows("1:3").Select
Range("A3").Activate
ActiveWindow.FreezePanes = True
Range("A2").Select
Selection.AutoFilter
Range("D1").Select
ActiveCell.Value = Format(Now, "dd.mm.yyyy")

End Sub
[/vba]

Автор - dmtgrs
Дата добавления - 25.12.2018 в 14:40
_Boroda_ Дата: Вторник, 25.12.2018, 15:09 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14501
Репутация: 5789 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
как у вас так хитро сообщение вылетает

Очень просто - обращаемся к первой ячейке листа с сегодняшней датой. Если ошибки нет, то это означает, что такой лист уже есть, тогда пишем ругалку и выходим из макроса


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
как у вас так хитро сообщение вылетает

Очень просто - обращаемся к первой ячейке листа с сегодняшней датой. Если ошибки нет, то это означает, что такой лист уже есть, тогда пишем ругалку и выходим из макроса

Автор - _Boroda_
Дата добавления - 25.12.2018 в 15:09
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Возврат на лист предыдущего дня (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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