Excel VBA - 查找具有变量名的文件（工作日函数）

Question

我有一个脚本，除其他外，它加载具有与日期相对应的可变文件名的文件。它可以加载过去 7 天内的日期，但是，我需要它加载过去 7 天内的日期。

脚本将在周五早上运行，我需要它来拉动整个星期，再加上整个前一周。目前，它将上周五（7天前）拉到前一天（周四）。

我需要的是正确的代码来让它从上周一到上周四拉。

上周一拉取的代码如下。我尝试将 Date - 1 更改为 Date - 2，但这是不对的。我知道 vbMonday 应该对应于过去 7 天内的某个日期（如果我理解正确的话。可能我错过了一件简单的事情，但似乎没有任何选项有效。

（仅供参考，所有变量都已声明，只是省略了以便更容易看到发生了什么）

LastMondayDate = Format(Date - (Weekday(Date - 1, vbMonday)), "m.d.yy")
fullFileNameLastMonday = strFilePath & LastMondayDate & ".xls"
If Dir(fullFileNameLastMonday) = "" Then
    MsgBox "File for last Monday doesn't exist!"
    GoTo ExitLastMonday
End If
Set wbkLastMonday = Workbooks.Open(fullFileNameLastMonday, False, True)
.......Do stuff.......
wbkLastMonday.Close SaveChanges:=False

退出上周一：

Answer 1

Weekday 函数返回一个介于 1 和 7 之间的数字，表示一周中的 7 天。 Weekday(Date, vbMonday) 指定星期一将是数字为 1 的日子，即一周的第一天。 Weekday(Date - 1, vbMonday) 将始终指定星期一。要指定另一天，请更改公式中的-1。

Date - Weekday(Date - 1, vbMonday) 连续 7 天指定同一天，因为随着日期的推进（每天 + 1），从中减去的 Weekday 也是如此。从周二到下周周一，它将指定本周的周一。然后会跳转到下周一。

为了捕捉更早的星期一，只需修改日期组件。 Date - 7 - Weekday(Date - 1, vbMonday) 将与刚才描述的完全相同，但在过去 7 天之后。

Answer 2

你可以试试这样的：

Public Sub LoveMondays()

    Dim i As Long

    For i = 1 To 15
        Debug.Print DateAdd("ww", i * -1, Date - (Weekday(Date, vbMonday) - 1))
    Next i

End Sub

它给出了过去 15 个星期一的日期。 然后，如果适用，以i 作为输入变量的 Debug.Print 函数会很有用。

例如：

Public Function MondaysWeekBack(lngWeekBack As Long) As Date
    MondaysWeekBack = DateAdd("ww", lngWeekBack * -1, Date - (Weekday(Date, vbMonday) - 1))
End Function

因此，对于本周，您可以像这样获得星期一： MondaysWeekBack(0) 而对于之前的MondaysWeekBack(1)。

这是DateAdd - https://msdn.microsoft.com/en-us/library/hcxe65wz(v=vs.90).aspx 的 Microsoft 参考

编辑：正如@Robin Mackenzie 在评论中所建议的那样，可以扩展该函数以使一天也成为变量。像这样：

Public Function WeekdayWeekBack(lngWeekBack As Long, _ 
                       Optional lngWeekday As Long = 2) As Date

    WeekdayWeekBack = DateAdd("ww", lngWeekBack * -1, Date - (Weekday(Date, lngWeekday) - 1))
End Function

如果我们想要最后一个星期日，我们应该像这样WeekdayWeekBack(0,1) 或WeekdayWeekBack(0,vbSunday)。默认情况下是星期一，因此WeekdayWeekBack(0) 将给我们最后一个星期一。

Answer 3

来试试这个

Private Sub that()

    Dim LastDate As Date
    Dim NewDate As Date
    Dim path As String
    Dim filename As String


        Select Case Weekday(Now())
            Case Is = 2
                LastDate = Format(DateAdd("d", -14, Date), "mm-dd-yyyy")
            Case Is = 3
                LastDate = Format(DateAdd("d", -14, Date), "mm-dd-yyyy")
            Case Is = 4
                LastDate = Format(DateAdd("d", -15, Date), "mm-dd-yyyy")
            Case Is = 5
                LastDate = Format(DateAdd("d", -16, Date), "mm-dd-yyyy")
            Case Is = 6
                LastDate = Format(DateAdd("d", -18, Date), "mm-dd-yyyy")
        End Select

        NewDate = LastDate + 11
        path = "" & "\"
        filename = Dir(path & "*.xl??")

         Do While Len(filename) > 0
            this = Mid(filename, InStrRev(filename, "\") + 1, InStrRev(filename, "."))
            this = Left(this, InStr(this, ".") - 1)
            If CDate(this) >= LastDate And CDate(this) <= NewDate Then
                ' do your stuff
            End If
         Loop
End Sub

这可以在一周中的任何一天运行，并获取前两周的最后一个星期。它说“做你的东西”的部分是你放置动作代码主体的地方。我做了一些字符串操作，通过检查当前文件是否在您要检查的日期范围内强制它们对值进行日期设置。这没有经过测试，但我 100% 可以正常工作。此外，您需要设置路径变量，但我确信它 100%==to strFilePath。

Answer 4

我认为将代码从 LastMondayDate、LastTuesdayDate、LastWednesdayDate 更改为更简单的代码会更容易：FirstDayToGet。请注意，以下只是逻辑。此逻辑将打开从开始日期到当前日期所需的所有日期文件 - 或者，如果当前日期太宽，您可以添加结束日期

Sub logicOnlyNotActualCode()
FirstDayToGet = datepicker or textbox value date or cell value date
toooooday = date() ' or some end date

for I = FirstDayToGet to FirstDayToGet + (toooooday - FirstDayToGet)
    run get_date_report(FirstDayToGet)
    FirstDayToGet = dateAdd("d",1,FirstDayToGet)
next i
End Sub

你的函数看起来像：

function get_date_report(FirstDayToGet as date)
dim get_report as string
    get_report = strFilePath & Format(FirstDayToGet , "m.d.yy")  & ".xls"

Do events
End function

Answer 5

此函数返回从numDays 天前到昨天日期的日期值，包括日期。它不考虑假期或周末等例外情况。您应该做的是使用此函数来构建文件名，然后使用Dir 函数来测试文件是否存在，并且（显然）如果文件不存在存在，不要尝试打开或处理它，继续下一个迭代。

Function GetFileNames(numDays As Long, optional dFormat as String = "m.d.yy")
'Function returns a string array (len = numDays) of formatted date values
'beginning from numDays days ago, until yesterday's date.
ReDim filenames(1 To numDays) As String
Dim LastDate As Date, i As Long

LastDate = Date 'Returns TODAY's date
'Use DateAdd function to calculate the last numDays:
For i = 1 To numDays
    filenames(i) = Format(DateAdd("d", -(numDays) + i - 1, LastDate), dFormat)
Next

GetFileNames = filenames
End Function

您可以通过以下方式对其进行测试：

Sub TestMe()
Dim a
a = GetFileNames(1) 'Should return an array of len=1, yesterday's date only
MsgBox a(1) 
a = GetFileNames(14) 'Should return an array of len=14, fourteen days prior to and including Yesterday

End Sub

这是在不创建 14 个变量/工作簿对象的情况下获取所有 14 个文件名的方法：

Dim dateVals 
dateVals = GetFileNames(14)

现在，对数组做一些事情（比如打开相应的工作簿并以某种方式处理它们：

Dim val, Dim wb as Workbook
For Each val in DateVals
    If Dir(strFilePath & val & ".xls") <> "" Then
        Set wb = Workbooks.Open(strFilePath & val & ".xls")
        'Do something with the workbook
        wb.Close
    End If
Next