DateDiffCount每個月的出現次數，日期之間的每周

我有一些基于估計的資源資料，這些資料顯示我每月分配給任務的每個“角色”的小時數。

我需要能夠計算“月”在兩個日期之間的每周計數中出現的次數。所以我可以相應地分配時間。

即 02-Oct-21 和 27-Nov-21 之間有 9 周，從下面的代碼輸出：

Public Sub dtConv()

Dim stDt, enDt As Date

stDt = Sheets("New Job Template").Range("F1").Value
enDt = Sheets("New Job Template").Range("H1").Value

Debug.Print (DateDiff("ww", stDt, enDt))

End Sub

顯示 8 周（這是錯誤的）。

但是上面并沒有告訴我“十一月”發生了5次，“十二月”發生了4次。

我可以利用 DateDiff 來計算開始/結束日期之間發生的 11 月/12 月/1 月等的次數嗎？

uj5u.com熱心網友回復：

請測驗下一個代碼。它將回傳正確的周數、10 月和 11 月的發生次數：

Private Sub testTextEvaluateDateManyMonths()
 Dim arrD, stDt As Date, enDt As Date, noD As Long, startD As Long, startM As Long, i As Long, mName As String
 Dim WCount As Long, prevWNo As Long, wNo As Long, k As Long, dictM As Object
 Const firstWeekDay As Long = vbMonday '(2) you should use here your first day of the week.
                                                        ' for Sunday you should use vbSunday, or 1

  stDt = "02-Oct-21": enDt = "28-Feb-22"
  noD = enDt - stDt   1      ' number of involved days between the two date
  startM = month(stDt)       ' month number in stDt
  startD = Day(stDt)         ' day number in stDt
  'create an array of involved dates:
  'arrD = Application.Transpose(Evaluate("TEXT(DATE(2021," & startM & ",row(" & startD & ":" & noD   1 & ")),""dd.mm.yyyy"")"))
  arrD = Evaluate("TEXT(DATE(2021," & startM & ",row(" & startD & ":" & noD   1 & ")),""dd.mm.yyyy"")")
  ReDim arrMonths(DateDiff("m", stDt, enDt, vbMonday))
  Debug.Print Join(Application.Transpose(arrD), "|") 'just to see the date range in Immediate Window...
  Set dictM = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arrD)
    wNo = WorksheetFunction.WeekNum(CDate(arrD(i, 1)), firstWeekDay)
    If wNo <> prevWNo Then prevWNo = wNo: WCount = WCount   1
    mName = Format(CDate(arrD(i, 1)), "mmmm")
    dictM(mName) = dictM(mName)   1
  Next i

  For i = 0 To dictM.Count - 1
        Debug.Print "Month " & dictM.Keys()(i) & " appears " & dictM.items()(i) & " times."
  Next i
  Debug.Print "Weeks number: " & WCount
End Sub

上面的代碼構建了一個必要天數范圍的陣列并非常快速地分析它（在記憶體中），提取你需要的（我理解的）。

firstWeekDay需要常數。如果“02-Oct-21”是星期一的星期日，則回傳周數的函式可能會以正數或負數回傳一周（以星期日結束）。對于您需要的范圍（現在）沒關系，但如果您更改相關日期，則可能很重要，以獲得準確的回報......

如果有不清楚的地方或要從天數范圍中提取的其他內容，請隨時要求澄清。

uj5u.com熱心網友回復：

不確定這是否是您想要的，但看看您如何進行并根據需要進行調整。能不能做得更好？！！或許！

Scripting.Dictionary在您的專案中添加對的參考，并將您的日期分別放在A1(From date) 和A2(To date) 中。

Public Sub CountMonthsInWeeks()
    Dim objValues As Scripting.Dictionary

    Dim dtFrom As Date, dtTo As Date, bDone As Boolean
    Dim dtFromTemp As Date, dtToTemp As Date, intMonth As Integer
    Dim strKey As Variant, strMonth As String
    
    Set objValues = New Scripting.Dictionary
    
    dtFrom = CDate(Sheet1.Range("A1").Value)
    dtTo = CDate(Sheet1.Range("A2").Value) - 1
    
    dtFromTemp = dtFrom
    
    Do While Not bDone
        dtToTemp = dtFromTemp   6
        
        Debug.Print "From = " & dtFromTemp & ", To = " & dtToTemp
        
        If dtToTemp >= dtTo Then
            dtToTemp = dtTo
            bDone = True
        End If
        
        UpdateMonthCount objValues, Month(dtFromTemp)
        If Month(dtToTemp) <> Month(dtFromTemp) Then UpdateMonthCount objValues, Month(dtToTemp)
        
        dtFromTemp = dtToTemp   1
    Loop
    
    Debug.Print ""
    
    For Each strKey In objValues.Keys
        strMonth = WorksheetFunction.Text(DateSerial(Year(Now), strKey, 1), "mmm")
        Debug.Print "Month " & strMonth & " = " & objValues.Item(strKey)
    Next
End Sub

Private Sub UpdateMonthCount(ByRef objValues As Scripting.Dictionary, ByVal intMonth As Integer)
    If Not objValues.Exists(intMonth) Then objValues.Add intMonth, 0
    objValues.Item(intMonth) = objValues.Item(intMonth)   1
End Sub

我假設開始日期始終是正確的日期，我不會檢查它是否如您所描述的那樣。這對我來說似乎有點矯枉過正。

標籤：

上一篇：運行n行的計算函式

下一篇：EXCELVBA豎排文本