Office中国论坛/Access中国论坛

标题: 查询遗漏的日期 [打印本页]

作者: 123shusheng 时间: 2013-8-22 22:13
标题: 查询遗漏的日期
我有一个数据表，每天会生成一行数据，因为需要多人输入，有时候会有遗漏。我用笨办法设计了一个查询。先做了一个日期表，将每天的日期都输进去，然后与数据表的日期连接，在窗体组合框里显示数据表内遗漏的日期，提示补充。
请高手指点，是否有简便的方法，谢谢！[attach]52353[/attach]

作者: todaynew 时间: 2013-8-23 13:21
请参见如下示例：
Function GetDateList(ByVal y As Long, ByVal m As Long) As String
Dim str As String
Dim ssql As String
Dim i As Long
Dim d0 As Date
Dim d1 As Date

ssql = "select * from 数据表 where year(日期)=" & y & " and month(日期)=" & m
Me.数据表.RowSource = ssql

If Year(Date) = y And Month(Date) = m Then
      d1 = Date
Else
      d1 = DateSerial(y, m + 1, 0)
End If

str = ""
d0 = DateSerial(y, m, 1)
Do While d0 <= d1
      If DCount("*", "数据表", "日期=#" & d0 & "#") = 0 Then
         str = str & d0 & ";"
      End If
      d0 = DateAdd("d", 1, d0)
Loop
str = Left(str, Len(str) - 1)
GetDateList = str
End Function

作者: 123shusheng 时间: 2013-8-23 16:13

todaynew 发表于 2013-8-23 13:21
请参见如下示例：
Function GetDateList(ByVal y As Long, ByVal m As Long) As String
Dim str As S ...

楼上的回复已经查收，遗漏日期中不包含今天，即当日，需修要改哪一条?请指点一下！

作者: todaynew 时间: 2013-8-24 07:23
If Year(Date) = y And Month(Date) = m Then
      d1 = DateAdd("d", -1, Date)
   Else
      d1 = DateSerial(y, m + 1, 0)
   End If

作者: 123shusheng 时间: 2013-8-24 08:03
谢谢todaynew ，成功了！

作者: 123shusheng 时间: 2013-8-24 11:41
经过测试，这个方法绑定数据表，如果有多个表需要使用，只能一一对应去修改，能否将数据表设为变量，根据需要去指定，就更好了！

作者: todaynew 时间: 2013-8-27 10:35
本帖最后由 todaynew 于 2013-8-27 10:40 编辑

123shusheng 发表于 2013-8-24 11:41
经过测试，这个方法绑定数据表，如果有多个表需要使用，只能一一对应去修改，能否将数据表设为变量，根据需 ...

将数据表名和日期字段名作为参数带入不就完事了

Function GetDateList(ByVal y As Long, ByVal m As Long,Byval tbname as string,DateFildname as string) As String

......
......
ssql = "select * from " & tbname & " where year(" & DateFildname & ")=" & y & " and month(" & DateFildname & ")=" & m
......
......
End Function

作者: 123shusheng 时间: 2013-8-27 21:31
[attach]52367[/attach]

我按照您的说法进行了修改，但提示参数类型不对，请指点指点！谢谢！

作者: todaynew 时间: 2013-8-28 14:49

123shusheng 发表于 2013-8-27 21:31
我按照您的说法进行了修改，但提示参数类型不对，请指点指点！谢谢！

参数是字符型的，当然应该加引号后带入。

作者: 123shusheng 时间: 2013-8-28 20:32
[attach]52374[/attach]

我加引号带入，显示无效的null使用，请指点，谢谢！

作者: 123shusheng 时间: 2013-8-29 13:30

经过摸索，应该是这样的，我明白了。谢谢论坛里的各位老大的指点！
Private Sub 年度_AfterUpdate()
If IsNull(Me.年度.Value) = False And IsNull(Me.月度.Value) = False Then
      Me.遗漏日期.RowSource = GetDateList(Me.年度.Value, Me.月度.Value, "数据表", "日期")
End If
End Sub

Private Sub 月度_AfterUpdate()
If IsNull(Me.年度.Value) = False And IsNull(Me.月度.Value) = False Then
      Me.遗漏日期.RowSource = GetDateList(Me.年度.Value, Me.月度.Value, "数据表", "日期")
End If
End Sub

Function GetDateList(ByVal y As Long, ByVal m As Long, ByVal tbname As String, DateFildname As String) As String

Dim str As String
Dim ssql As String
Dim i As Long
Dim d0 As Date
Dim d1 As Date

ssql = "select * from " & tbname & " where year(" & DateFildname & ")=" & y & " and month(" & DateFildname & ")=" & m

Me.数据表.RowSource = ssql

If Year(Date) = y And Month(Date) = m Then
      d1 = Date
Else
      d1 = DateSerial(y, m + 1, 0)
End If

str = ""
d0 = DateSerial(y, m, 1)
Do While d0 <= d1
      If DCount("*", "" & tbname & "", "日期=#" & d0 & "#") = 0 Then
         str = str & d0 & ";"
      End If
      d0 = DateAdd("d", 1, d0)
Loop
str = Left(str, Len(str) - 1)
GetDateList = str
End Function

作者: 123shusheng 时间: 2013-9-28 18:30
[attach]52464[/attach]

经过一段时间的使用，的确可以检查遗漏的日期，但存在一个问题，如果没有遗漏的日期，就会出现提示框，提示运行错误需要调试，能否不不出现提示框，遗漏日期列表框中显示空白就行了，请高手指点，谢谢！

作者: 123shusheng 时间: 2013-9-28 18:40
str = Left(str, Len(str) - 0)
我知道了，要修改这一句，

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)