2015-12-16 31 views
0

我想要一个文本框“txtWeek”来显示星期五或月到当前日期的开始之间周四,IE我已经开始用需要计算两个日期之间的特定日期的数量从当前月份的开始到现在()的IE数量在excel vba

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 

回答

-1

此UDF将计算任何一天的传递到它作为多头经过两个日期之间的数字。

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 

周日表示星期几,例如,星期日= 1,星期一= 2 ...等 我不知道它是否改变为星期一= 1,星期二= 2等在其他系统上,或者它总是星期日= 1。

有了这个用户窗体代码,一个文本框将显示ANYDAY的数量取决于组合框的值:

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()中,这样当组合框发生变化时它就会更新文本框。

+0

任何解释的downvote?这对我来说非常合适。 – Alex4336

+0

我得到了一个编译错误的未定义“HowManyDays” – GregNH

+0

你是否从我的答案的顶部实现了功能? – Alex4336

0

要求:

  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 

此函数计算da的数量ys从输入日期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 keywordVariables & ConstantsData Type Summary

Optional keywordFunction StatementFor...Next Statement

If...Then...Else StatementControl and Dialog Box Events

Select Case StatementWorksheetFunction Object (Excel)

相关问题