2015-12-16 29 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)

相關問題