需要计算两个日期之间特定日期的数量IE excel vba中从本月初到现在的星期五数量()

Question

我想要一个文本框"txtWeek"来显示从月初到当前日期之间的星期五或星期四的数量，IE我已经开始使用

Dim MyDate, MyStr
    MyDate = Format(Now, "M/d/yy")
    Me.txtDate.Value = MyDate
Dim Day As Variant
    ReDim Day(2)
    Day = Array("Thursday", "Friday")
    ComboBox1.ColumnCount = 1
    ComboBox1.List() = Day
Dim X, AsDate
    X = Format(Now, "M/1/yy")
If Me.ComboBox1.Text = "Friday" Then
    Me.txtWeek.Value = Int((Weekday(X - 6) - X + Me.txtDate.Value) / 7)
Else
End If
End Sub

Answer 1

要求：

1. 在文本框txtDate中显示机器的日期
2. 计算截至机器日期的txtDate月份的星期五或星期四的数量
3. 在文本框txtWeek中显示上一点的周五或周四数

假设：

1. 包含过程的工作簿的Sheet1有两个TextBoxes和一个ComboBox
2. 当用户选择要计数的工作日时，ComboBox的更改事件将触发程序

将此过程复制到Sheet1的代码模块-组合框的更改事件

Private Sub CmbBox1_Change()
Dim sWkDy As String
Dim dDte1 As Date
Dim bDayC As Byte
Dim bThu As Boolean, bFri As Boolean
    Rem Set Weekday
    sWkDy = Me.CmbBox1.Value
    Select Case sWkDy
    Case "Thursday":    bThu = True
    Case "Friday":      bFri = True
    Case Else:          Exit Sub
    End Select
    Rem Set First date of the current month
    dDte1 = 1 + WorksheetFunction.EoMonth(Date, -1)
    Rem Counts the weekdays
    bDayC = Dte_Days_Count_To_Today(dDte1, blThu:=bThu, blFri:=bFri)
    Rem Set Current Date in `txtDate`
    'Using format `mmm-dd-yyyy` to ease reading of the date independently of the format (American or International)
    Me.TxtDate.Value = Format(Date, "mmm-dd-yyyy")  'change as required
    Rem Set count of weekdays `txtWeek`
    'Using this format to directly show the weekdays counted
    Me.TxtWeek.Value = "Count of " & sWkDy & "s: " & bDayC 'change as required
End Sub

在标准模块中复制这些过程

'Ensure these Keywords are at the top of the module 
Option Explicit
Option Base 1        

此过程设置Combobox中的可用选项–首先运行此，只需运行一次

Private Sub CmbBox1_Set()
Dim aWkDys As Variant
aWkDys = [{"Thursday", "Friday"}]
    With Me.CmbBox1
        .ColumnCount = 1
        .List() = aWkDys
    End With
End Sub

此功能统计从输入日期dDteInp到机器实际日期TODAY的天数。结果是使用算术演算生成的，避免了该范围内每个日期的循环。它还提供了一次计算各种工作日的选项，例如：从给定日期到今天计算星期四和星期五，这样称为Call Dte_Days_Count_To_Today(dDteInp, blThu:=True, blFri:=True)

Public Function Dte_Days_Count_To_Today(dDteInp As Date, _
    Optional blSun As Boolean, Optional blMon As Boolean, _
    Optional blTue As Boolean, Optional blWed As Boolean, _
    Optional blThu As Boolean, Optional blFri As Boolean, _
    Optional blSat As Boolean)
Dim aDaysT As Variant, bDayT As Byte    'Days Target
Dim bDayI As Byte                       'Day Ini
Dim iWeeks As Integer                   'Weeks Period
Dim bDaysR As Byte                      'Days Remaining
Dim bDaysA As Byte                      'Days Additional
Dim aDaysC(7) As Integer                'Days count
    Rem Set Days Base
    aDaysT = Array(blSun, blMon, blTue, blWed, blThu, blFri, blSat)
    bDayI = Weekday(dDteInp, vbSunday)
    iWeeks = Int((Date - dDteInp + 1) / 7)
    bDaysR = (Date - dDteInp + 1) Mod 7
    Rem Set Day Target Count
    For bDayT = 1 To 7
        bDaysA = 0
        aDaysC(bDayT) = 0
        If aDaysT(bDayT) Then
            If bDaysR = 0 Then
                bDaysA = 0
            ElseIf bDayI = bDayT Then
                bDaysA = 1
            ElseIf bDayI < bDayT Then
                If bDayI + bDaysR - 1 >= bDayT Then bDaysA = 1
            Else
                If bDayI + bDaysR - 8 >= bDayT Then bDaysA = 1
            End If
            Rem Target Day Total
            aDaysC(bDayT) = iWeeks + bDaysA
    End If: Next
    Rem Set Results - Total Days
    Dte_Days_Count_To_Today = WorksheetFunction.Sum(aDaysC)
End Function

建议阅读以下页面以更深入地了解所使用的资源：

Option关键字，变量&常数，数据类型摘要，

可选关键字，函数语句，对于下一个声明，

如果。。。然后Else语句，控制和对话框事件，

选择案例陈述，工作表功能对象（Excel）

Answer 2

这个UDF将计算您进入其中的任何一天的数量，介于作为long传递的两个日期之间。

Public Function HowManyDays(Sdate As Long, Edate As Long, Wday As Long)
Dim i
Dim MyCount As Long
For i = Sdate To Edate
    If Weekday(i) = Wday Then MyCount = MyCount + 1
Next i
HowManyDays = MyCount
End Function

Wday表示一周中的某一天，例如星期日=1，星期一=2…等等。我不知道在其他系统上是改为星期一=1，星期二=2等等，还是总是星期天=1。

有了这个UserForm代码，一个文本框将显示任意一天的数量，具体取决于组合框中的值：

Private Sub CommandButton1_Click()
Dim Sdate As Long, Edate As Long, Wday As Long
Sdate = CLng(DateSerial(Format(Now, "yy"), Format(Now, "mm"), 1))
Edate = CLng(Now)
Select Case ComboBox1.Value
    Case "Sunday"
        Wday = 1
    Case "Monday"
        Wday = 2
    Case "Tuesday"
        Wday = 3
    Case "Wednesday"
        Wday = 4
    Case "Thursday"
        Wday = 5
    Case "Friday"
        Wday = 6
    Case "Saturday"
        Wday = 7
End Select
TextBox1.Value = HowManyDays(Sdate, Edate, Wday)

End Sub
Private Sub UserForm_Initialize()
Dim Day As Variant
ReDim Day(7)
Day = Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")
ComboBox1.ColumnCount = 1
ComboBox1.List() = Day

End Sub

开始日期当前设置为当前月份的第一个。

如果你不想点击按钮执行操作，你可以从CommandButton1_click（）中获取代码，并将其放入ComboBox1_Change（）中，这样每当组合框发生变化时，它就会更新文本框。