本周次数

cmo9020

请教导师们一下
A列是日期
读取O列项目
O列和Q列比对相同的把次数填入R列
但是我要的结论次数是以"本周为主"

问题来了,如果以周为主又不想多添加一列周数
要怎么使用代码直接把日期读取成周数
周一~周日为一周


那要怎么用代码做周数的转换?
请各位导师指导,谢谢


Sub tset()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim startDate As Date, endDate As Date
    Dim searchStrings As Variant
    Dim counts As Object
    Dim i As Long
   
    Set ws = ThisWorkbook.Worksheets("Sheet1")
   
    startDate = DateSerial(2023, 1, 1)
    endDate = DateSerial(2025, 12, 31)
   
    searchStrings = ws.Range("Q2:Q5").Value
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
   
    Set counts = CreateObject("Scripting.Dictionary")
   
    For i = 2 To lastRow
        If ws.Cells(i, "A").Value >= startDate And ws.Cells(i, "A").Value <= endDate Then
            If Not counts.Exists(ws.Cells(i, "O").Value) Then
                counts.Add ws.Cells(i, "O").Value, 0
            End If
            counts(ws.Cells(i, "O").Value) = counts(ws.Cells(i, "O").Value) + 1
        End If
    Next i
   
    For i = 1 To UBound(searchStrings, 1)
        If counts.Exists(searchStrings(i, 1)) Then
            ws.Range("R" & (i + 1)).Value = counts(searchStrings(i, 1))
        End If
    Next i
End Sub