VBA - Если предыдущий день является выходным днем, откройте файл за предыдущий рабочий день

Я борюсь с разработкой этого. По сути, у меня сейчас есть код для открытия файла предыдущих рабочих дней.

x = Weekday(Date, vbSunday)
    Select Case x
        Case 1
            x = 2
        Case 2
            x = 3
        Case Else
            x = 1

    End Select

    Workbooks.Open Filename:= _
    "filepath" & Format(Date - x, "yymmdd") & " - filename.xlsx"

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

Четверг 29/03/2018 - Рабочий день

Пятница 30/03/2018 - Страстная пятница (выходной день)

Понедельник 02/04/2018 - Пасхальный понедельник (выходной день)

Вторник 03/04/2018 - рабочий день

Когда я прихожу во вторник и запускаю свой макрос, я хочу, чтобы он взял файл с последними рабочими днями и использовал его (четверг 29/03). С моим текущим кодом, который не будет поднят, и он будет искать файл понедельника (который, очевидно, не существует).

Надеюсь это имеет смысл!

Спасибо Джейсон

Источник

2 ответа

Решение

Вы можете получить последний предыдущий рабочий день с

Так что получите последний предыдущий рабочий день с...

Dim LastPreviousWorkday As Date
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date(), -1)

И напр. вывести его в формате

Format$(LastPreviousWorkday, "yymmdd")

Вы можете сказать WorkDay Функция, даты которой (помимо выходных) должны рассматриваться как выходные, например, путем предоставления массива или диапазона в качестве третьего аргумента.

Dim BankHolidays As Variant
BankHolidays = Array(#3/26/2018#, #3/23/2018#) 'array of bank holidays, or a range in a 
                                               'sheet where the dates of bank holidays
                                               'are saved in.

Dim LastPreviousWorkday As Date
LastPreviousWorkday = Application.WorksheetFunction.WorkDay(Date, -1, BankHolidays)

или если вы хотите использовать рабочий лист с датами праздников

Application.WorksheetFunction.WorkDay(Date, -1, Worksheets("MyHolidays").Range("A:A"))
 'considers all dates in column A of sheet MyHolidays as non-workdays
Источник

Это исчерпывающий ответ - основная часть кода определяет, какие дни являются выходными днями (в Великобритании), и получает главные (выдерживая королевские свадьбы / смерти).

Вам также понадобится лист в вашем файле с именем Holidays и он создаст именованный диапазон под названием "BankHolidays".

Тогда он просто использует Workday формула, которую @Peh использовал в своем ответе.

Public Sub Test()

    Dim CurrentWorkDay As Date
    Dim LastWorkDay As Date

    Dim wrkBk_To_Open As Workbook

    'Day after Easter Monday.
    CurrentWorkDay = DateSerial(2018, 4, 3)

    'CHANGE YEAR AS REQUIRED - all other procedures are because of this.
    DisplayBankHolidays 2018

    'THIS IS THE ONLY IMPORTANT LINE OF CODE - THE ONE THAT CALCULATES THE LAST WORK DAY.
    LastWorkDay = Application.WorksheetFunction.WorkDay(CurrentWorkDay, -1, Range("BankHolidays"))

    MsgBox Format(LastWorkDay, "ddd dd mmm yy"), vbOKOnly

    'Set wrkBk_To_Open = Workbooks.Open("filepath\" & Format(LastWorkDay, "yymmdd") & " - filename.xlsx")
    'msgbox wrkbk_to_open.name & vbcr & "contains " & wrkbk_to_open.sheets.count & " sheets."

End Sub

Public Sub DisplayBankHolidays(lYear As Long)

    Dim BH As Collection
    Dim vBH As Variant
    Dim lRow As Long
    Dim HolidaySheet As Worksheet


    Set BH = New Collection

    Set HolidaySheet = ThisWorkbook.Worksheets("Holidays")

    Set BH = BankHolidays(lYear)
    lRow = HolidaySheet.Cells(HolidaySheet.Rows.Count, 1).End(xlUp).Row + 1

    For Each vBH In BH
        Sheet1.Cells(lRow, 1) = vBH
        lRow = lRow + 1
    Next vBH

    With HolidaySheet
        .Range(.Cells(1, 1), .Cells(lRow, 1)).RemoveDuplicates 1, xlNo
        AllocateNamedRange ThisWorkbook, "BankHolidays", "='" & HolidaySheet.Name & "'!" & .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Address, "A1"
    End With

End Sub

'This could be improved - just haven't had time yet.
Public Function BankHolidays(lYear As Long) As Collection

    Dim colTemp As Collection
    Dim dDateInQuestion As Date
    Dim dTemp As Date
    Set colTemp = New Collection

    'New Years Day
    'If falls on a weekend then following Monday is BH.
    dDateInQuestion = DateSerial(lYear, 1, 1)
    If Weekday(dDateInQuestion, vbMonday) >= 6 Then
        dTemp = dDateInQuestion + 8 - Weekday(dDateInQuestion, vbMonday)
    Else
        dTemp = dDateInQuestion
    End If
    colTemp.Add dTemp, "NewYearsDay"

    'Easter
    'Easter is the Sunday so isn't added,
    'but Good Friday & Easter Monday are calculated from this date.
    dTemp = EasterDate(CInt(lYear))
    colTemp.Add dTemp - 2, "GoodFriday"
    colTemp.Add dTemp + 1, "EasterMonday"

    'Early May Bank Holiday.
    'First Monday in May.
    dDateInQuestion = DateSerial(lYear, 5, 1)
    If Weekday(dDateInQuestion, vbMonday) > 1 Then
        dTemp = dDateInQuestion + 8 - Weekday(dDateInQuestion, vbMonday)
    Else
        dTemp = dDateInQuestion
    End If
    colTemp.Add dTemp, "EarlyMayBankHoliday"

    'Spring Bank Holiday
    'Last Monday in May.
    dDateInQuestion = DateSerial(lYear, 6, 1)
    dTemp = dDateInQuestion - Weekday(dDateInQuestion, vbTuesday)
    colTemp.Add dTemp, "SpringBankHoliday"

    'Summer Bank Holiday
    dDateInQuestion = DateSerial(lYear, 9, 1)
    dTemp = dDateInQuestion - Weekday(dDateInQuestion, vbTuesday)
    colTemp.Add dTemp, "SummerBankHoliday"

    'Christmas Day
    'Records 25th as BH and following Monday if Christmas is on Saturday or
    'following Tuesday if Christmas is on Sunday.
    dDateInQuestion = DateSerial(lYear, 12, 25)
    If Weekday(dDateInQuestion, vbMonday) = 6 Then
        dTemp = dDateInQuestion + 8 - Weekday(dDateInQuestion, vbMonday)
        colTemp.Add dTemp, "ChristmasDay"
    ElseIf Weekday(dDateInQuestion, vbMonday) = 7 Then
        dTemp = dDateInQuestion + 8 - Weekday(dDateInQuestion, vbMonday) + 1
        colTemp.Add dTemp, "ChristmasDay"
    Else
        colTemp.Add dDateInQuestion, "ChristmasDay"
    End If

    'Boxing Day
    'Records 26th as BH.
    'If 26th is Saturday, then following Monday is BH.
    'If 26th is Sunday, then following Tuesday is BH.
    dDateInQuestion = DateSerial(lYear, 12, 26)
    If Weekday(dDateInQuestion, vbMonday) = 6 Then
        dTemp = dDateInQuestion + 8 - Weekday(dDateInQuestion, vbMonday)
        colTemp.Add dTemp, "BoxingDay"
    ElseIf Weekday(dDateInQuestion, vbMonday) = 7 Then
        dTemp = dDateInQuestion + 9 - Weekday(dDateInQuestion, vbMonday)
        colTemp.Add dTemp, "BoxingDay"
    Else
        colTemp.Add dDateInQuestion, "BoxingDay"
    End If

    Set BankHolidays = colTemp

End Function

'---------------------------------------------------------------------------------------
' Procedure : EasterDate
' Author    : Chip Pearson
' Site      : http://www.cpearson.com/excel/Easter.aspx
' Purpose   : Calculates which date Easter Sunday is on.  Is good from 1900 to 2099.
'---------------------------------------------------------------------------------------
Public Function EasterDate(Yr As Integer) As Date
    Dim d As Integer
    d = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
    EasterDate = DateSerial(Yr, 3, 1) + d + (d > 48) + 6 - ((Yr + Yr \ 4 + _
            d + (d > 48) + 1) Mod 7)
End Function

Public Function NamedRangeExists(Book As Workbook, sName As String) As Boolean

    On Error Resume Next

        NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)

    On Error GoTo 0

End Function

Public Sub AllocateNamedRange(Book As Workbook, sName As String, sRefersTo As String, Optional ReferType = "R1C1")

    With Book
        If NamedRangeExists(Book, sName) Then .Names(sName).Delete
            If ReferType = "R1C1" Then
                .Names.Add Name:=sName, RefersToR1C1:=sRefersTo
        ElseIf ReferType = "A1" Then
                .Names.Add Name:=sName, RefersTo:=sRefersTo
        End If
    End With

End Sub
Источник
Другие вопросы по тегам