我创建了一个日历表以便更容易处理。我在下面包含了我使用的两个过程(CreateTable_calendar 和 LoadCalendar)的代码。我在日历表中添加了一个“work_day”字段,以防您希望将天数限制为仅组织每个月的工作日。如果是这样,您将需要相应地调整查询的 WHERE 子句。如果我的选择与您的选择不匹配,还可以重置每个日历日期的 work_day 值。
不管怎样,我会把这些细节留给你整理。在不针对工作与非工作日进行调整的情况下,此查询返回我认为您想要的结果集。
TRANSFORM Count(sub.the_date) AS CountOfProjectDays
SELECT sub.Project_name
FROM
(
SELECT
p.Project_name,
MonthName(Month(c.the_date),-1) AS month_name,
c.the_date
FROM Projects AS p, tblCalendar AS c
WHERE
c.the_date >= [p].[start_date]
And c.the_date <= [p].[end_date]
ORDER BY p.Project_name
) AS sub
GROUP BY sub.Project_name
PIVOT sub.month_name
In ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul",
"Aug", "Sep", "Oct", "Nov", "Dec");
注意事项:
- 我使用 PIVOT 之后的月份名称列表来强制列的顺序。如果没有该列表,列将按月份名称的字母顺序显示。如果您在 12 个月内不想要/不需要列,请缩短该列表。
- 当所有日期都来自一个日历年时,这种方法应该有效。如果您想处理跨越一年以上的日期范围……您还有更多工作要做。 :-)
制作日历表:
Public Sub CreateTable_calendar()
Const cstrTable As String = "tblCalendar"
Dim cn As Object
Dim strSql As String
Set cn = CurrentProject.Connection
On Error Resume Next
cn.Execute "DROP TABLE " & cstrTable & ";"
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
On Error GoTo 0
strSql = "CREATE TABLE " & cstrTable & " (" & vbCrLf & _
"the_date DATETIME CONSTRAINT pkey PRIMARY KEY," & vbCrLf & _
"work_day YESNO," & vbCrLf & _
"CONSTRAINT midnite_only CHECK " & _
"(the_date = DateValue(the_date))" & vbCrLf & _
");"
Debug.Print strSql
cn.Execute strSql
Set cn = Nothing
End Sub
加载日历表。如果没有给出年份的参数,它将加载当前年份的所有日期。否则,它将加载您提供的年份的日期作为参数。
Public Sub LoadCalendar(Optional ByVal pYear As Integer)
Const cstrTable As String = "tblCalendar"
Dim db As DAO.Database
Dim dte As Date
Dim intYear As Integer
Dim rs As DAO.Recordset
Dim strMsg As String
On Error GoTo ErrorHandler
intYear = IIf(pYear = 0, Year(Date), pYear)
dte = DateSerial(intYear, 1, 1)
Set db = CurrentDb
Set rs = db.OpenRecordset(cstrTable, dbOpenTable, dbAppendOnly)
Do While Year(dte) = intYear
rs.AddNew
rs!the_date = dte
rs!work_day = Not (Weekday(dte) = vbSunday Or _
Weekday(dte) = vbSaturday)
rs.Update
dte = dte + 1
Loop
rs.Close
ExitHere:
On Error GoTo 0
Set rs = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure LoadCalendar"
MsgBox strMsg
GoTo ExitHere
End Sub
编辑:日历是保留字。见Problem names and reserved words in Access。直到我使用 Browne 先生的 Database Issue Checker Utility 检查我的数据库时,我才注意到这一点。所以我在这个答案中将名称 calendar 更改为 tblCalendar 。我强烈推荐该实用程序。除了用保留字识别问题外,它还可以告知您许多其他潜在的问题问题。