如何解决用日期做While循环
我正在VBA中编写代码,该代码可以遍历日期并将某些数据添加到Access中的某些表。我觉得我已经尝试了一切并浏览了网络,但似乎仍然无法正常工作。我认为我的问题是日期格式,因为我使用的是欧洲日期输入,而不是美国输入。我试图格式化日期,如下面的代码所示。
Dim TODAY as string,TimeReg as string,UserReg as string,Init as string,_
SendFrom as string,SendTo as string,DateFrom as Date,DateTo as date,_
Comment as string
'Me.txtDateF.value Input f.ex. = 01-01-2020
'Me.txtDateT.value Input f.ex. = 16-01-2020
'Values'
TODAY = Me.txtDD.Value
TimeReg = Me.txtTime.value
UserReg = Left(Me.txtUser.value,3)
Init = Me.cmbInit.value
If IsNull(Me.txtFrom.value) Then
SendFrom = ""
Else
SendFrom = Me.txtFra.value
End if
SendTo = Me.cmbTo.Column(1)
DateFrom = CDate(Format(Me.txtDateF.value,"dd-mm-yyyy"))
DateTo = CDate(Format(Me.txtDateT.value,"dd-mm-yyyy"))
Comment = Me.txtComment.value
'Define team on which it will use in SQL-Query
Select Case Me.txtTeam.value
Case "Team 1"
Team = "Team1"
TeamCom = "Team1Com"
Case "Team 2" etc...
End select
DoCmd.SetWarnings False
Do While DateFrom < DateTo
strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = #" & DateFrom "#"
DoCmd.RunSQL strSQL
ChangeSQL = "INSERT INTO tblChanges " _
& "(Date,Time,InitChange,TimeR,ShiftB,ShiftA,DateR,DateT,Comment)" _
& "VALUES (#" & TODAY & "#,#" & TimeReg & "#,'" & Init & "','" & UserReg & "','" & SendFrom & "','" & SendTo & "',#" & DateFrom "# '" & Comment & "');"
DoCmd.RunSQL ChangeSQL
DateFrom = DateAdd("d",1,DateFrom)
Loop
DoCmd.SetWarnings True
如果输入日期来自f.ex。 2020年1月1日至2020年1月24日,以下日期会更改。
- 01-01-2020
- 2020年1月13日
- 2020年1月14日
- 2020年1月15日
- 2020年1月16日
- 2020年1月17日
- 18-01-2020
- 19-01-2020
- 20-01-2020
- 2020年1月21日
- 2020年1月22日
- 2020年1月23日
- 24-01-2020
- 01-02-2020
- 01-03-2020
缺少日期为01-01-2020到12-01-2020的日期。在我看来,格式已关闭。
解决方法
这里有很多错误,但这应该使您更接近:
Dim Today As Date,TimeReg As Date,UserReg As String,Init As String,_
SendFrom As string,SendTo As String,DateFrom As Date,DateTo As Date,_
Comment As String
'Me.txtDateF.value Input f.ex. = 01-01-2020
'Me.txtDateT.value Input f.ex. = 16-01-2020
'Values'
Today = TimeValue(Me!txtDD.Value)
TimeReg = Me!txtTime.Value
UserReg = Left(Me!txtUser.Value,3)
Init = Me!cmbInit.Value
If IsNull(Me!txtFrom.Value) Then
SendFrom = ""
Else
SendFrom = Me!txtFra.Value
End if
SendTo = Me!cmbTo.Column(1)
DateFrom = DateValue(Me!txtDateF.Value)
DateTo = DateValue(Me!txtDateT.Value)
Comment = Me!txtComment.Value
'Define team on which it will use in SQL-Query
Select Case Me!txtTeam.Value
Case "Team 1"
Team = "Team1"
TeamCom = "Team1Com"
Case "Team 2" etc...
End select
DoCmd.SetWarnings False
Do While DateFrom < DateTo
strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE [Date] = #" & Format(DateFrom,"yyyy\/mm\/dd") & "#"
DoCmd.RunSQL strSQL
' Correct here. Range of fields doesn't match range of values!
ChangeSQL = "INSERT INTO tblChanges " & _
"([Date],[Time],InitChange,TimeR,ShiftB,ShiftA,DateR,DateT,Comment)" & _
"VALUES (#" & Format(Today,"yyyy\/mm\/dd") & "#,#" & Format(TimeReg,"hh\:nn\:ss") & "#,'" & Init & "','" & UserReg & "','" & SendFrom & "','" & SendTo & "',#" & Format(DateFrom,#" & Format(DateTo,'" & Comment & "');"
DoCmd.RunSQL ChangeSQL
DateFrom = DateAdd("d",1,DateFrom)
Loop
DoCmd.SetWarnings True
或者使用我的函数CSql重写/简化SQL。
,我是如何解决的: 首先,我设置值
Date0 = DateAdd("d",CDate(Format(Me.txtDateF.value,"dd/mm/yyyy")))
然后,在sql语句中,我会这样写
strSQL = "UPDATE [" & Team & "] SET [" & Init & "] = '" & SendTo & "' WHERE Date = #" & Format(Date0,"yyyy/mm/dd") & "# "
希望有帮助。事实是访问中的日期在开始时也使我感到困惑!
,使用帮助程序函数创建SQL语句,可以独立于其余代码测试查询。
DateValue()
使用助手功能,我可以将SQL语句打印到立即窗口。然后,我将使用访问查询设计器来测试SQL。
使用Function mySum(rngDB As Range)
Dim mCol As Object 'MatchCollection
Dim Ws As Worksheet
Dim rng As Range
Dim strPattern As String
Dim s As String
Dim i As Integer,n As Integer
Dim vSum() As Variant
Application.Volatile
Set Ws = ActiveSheet
strPattern = "(()([0-9]{1,})())"
For Each rng In rngDB
s = rng.Value
Set mCol = GetRegEx(s,strPattern)
If Not mCol Is Nothing Then
For i = 0 To mCol.Count - 1
n = n + 1
ReDim Preserve vSum(1 To n)
vSum(n) = Val(mCol.Item(i))
Next i
End If
Next
If n Then
mySum = WorksheetFunction.Sum(vSum)
End If
End Function
Function GetRegEx(StrInput As String,strPattern As String) As Object
Dim RegEx As Object 'New RegExp
Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.IgnoreCase = False
.MultiLine = True
.Pattern = strPattern
End With
If RegEx.test(StrInput) Then
Set GetRegEx = RegEx.Execute(StrInput)
End If
End Function
从“日期”字段中删除时间值。
WHERE DateValue([Date])=#“&DateFrom”#“
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。