Нужно подсчитать число определенного дня между двумя датами 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

Эта 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 

Wday представляет собой день недели, например. sunday = 1, monday = 2 ... и т. д. Я не знаю, будет ли он изменяться в понедельник = 1, вторник = 2 и т. д. на других системах, или если это всегда воскресенье = 1.

С помощью этого UserForm кода, текстовое поле покажет количество 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(), таким образом он обновит текстовое поле всякий раз, когда изменяется значение combobox.

Answer 2

Требования:

1. показать в Textbox txtDate дату машины
2. Чтобы рассчитать количество пятницу или четверг в месяце txtDate до даты машины
3. К показать в текстовом поле txtWeek количество пятниц или четвергов в соответствии с предыдущей точкой

Предположение:

1. Sheet1 рабочей книги, содержащей процедуру имеет два TextBoxes и один ComboBox
2. Процедуры, будет вызвано событиями изменения ComboBox, когда пользователь выбирает день недели для подсчета

Скопируйте эту процедуру в модуле кода Sheet1 - Изменить событие для ComboBox

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 - Run это первый, нужно запустить только один раз

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 keyword, Variables & Constants, Data Type Summary,

Optional keyword, Function Statement, For...Next Statement,

If...Then...Else Statement, Control and Dialog Box Events,

Select Case Statement, WorksheetFunction Object (Excel)