我有一个脚本,除其他外,加载具有与日期对应的可变文件名的文件。它可以在最近7天内加载日期,但是,我需要它来加载日期。
该脚本将在星期五早上运行,我需要它来整整一周,加上前一周。目前,它将上一个星期五(7天前)拉到前一天(星期四)。
我需要的是正确的代码,以便在上周一到上周四使用它。
上周一提取的代码如下。我尝试过将Date - 1更改为Date - 2,但这不对。我知道vbMonday应该与过去7天内的日期相对应(如果我理解正确的话。可能是一件我想念的简单事情,但似乎没有选择。
(FYI所有变量都被声明,只是省略,因此更容易看到发生了什么)
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
ExitLastMonday:
答案 0 :(得分:1)
您可以尝试这样的事情:
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函数将非常有用。
E.g:
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
编辑:正如@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)
将在上周一给我们。
答案 1 :(得分:1)
工作日函数返回1到7之间的数字,表示一周中的7天。 Weekday(Date, vbMonday)
指定星期一将是数字1的日期,即一周的第一天。 Weekday(Date - 1, vbMonday)
将始终指定星期一。要指定其他日期,请更改公式中的-1
。
Date - Weekday(Date - 1, vbMonday)
指定连续7天的同一天,因为当日期提前(每天+ 1)时,从中减去的工作日也是如此。从周二到下周一,它将指定当前周的周一。然后它会跳到下周一。
为了捕获更早的星期一,只需修改日期组件即可。 Date - 7 - Weekday(Date - 1, vbMonday)
将与刚刚描述的完全相同但过去7天。
答案 2 :(得分:1)
这里试试这个
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
这可以在一周中的任何一天运行,并在前两周进行。它所说的部分&#34;&#39;做你的东西&#34;是您放置动作代码正文的地方。我做了一些字符串操作,强制它们使用检查来查看日期值,该检查查看当前文件是否在您要检查的日期范围内。这没有经过测试,但我100%正在工作。此外,您需要设置路径变量,但我确信它是100%==到strFilePath。
答案 3 :(得分:0)
我认为将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
答案 4 :(得分:0)
此函数返回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