|
本帖最后由 todaynew 于 2011-1-21 19:07 编辑
今天版友pzszdy同志问询一个追加查询写法问题。看了看他上传的实例,发现需要先做一个联合查询,再以联合查询为基础做一个交叉查询,最后用这个交叉查询追加到另外一个表中。本来问题不是很复杂,该同志非要说我没明白他的问题,于是便贴出来一堆代码,按照goto2008同志的习惯用语来说,叫做眼睛可以看骨折。于是我坚决的反对,强烈的不看,便告诉他在我写的交叉查询基础上,有两三句写一个追加查询的代码足够了。
令人愤慨的是,该同志说:不行!前面两个查询也不能要,都在代码中解决。于是对该同志进行了严正的谴责,告诉他这种想法叫做:“简单问题复杂,阳关道不走,非要走独木桥。”在对pzszdy同志进行谴责、批判和鄙视后,突然发现pzszdy同志的想法还是很有点意思。因为这个问题涉及到联合查询、交叉查询和追加查询的套用,如何能简洁明了的用代码来反映这个多种类型的查询套用过程,还是存在一些书写上的技巧的。于是便写了一个示例,供pzszdy同志和初学的同志们参考。
论坛原帖地址:http://www.accessoft.com/bbs/showtopic.asp?id=11368
Function 联合查询() As String
Dim ssql As String
ssql = "Select WY_News.Author, WY_News.E_typeid, Count(WY_News.NewsID) AS 计数 "
ssql = ssql & "FROM WY_News "
ssql = ssql & "Where (((WY_News.Author)<>'admin')) "
ssql = ssql & "GROUP BY WY_News.Author, WY_News.E_typeid "
ssql = ssql & "UNION ALL Select WY_News.Author, 'bs' AS E_typeid, Count(WY_News.NewsID) AS 计数 "
ssql = ssql & "FROM WY_News "
ssql = ssql & "Where (((WY_News.Author)<>'admin')) "
ssql = ssql & "GROUP BY WY_News.Author"
联合查询 = ssql
End Function
Function 交叉查询(Strsql As String) As String
Dim ssql As String
ssql = "TRANSFORM Sum(a.计数) AS 计数之总计 "
ssql = ssql & "Select a.Author "
ssql = ssql & "FROM (" & Strsql & ") AS a "
ssql = ssql & "GROUP BY a.Author "
ssql = ssql & "PIVOT a.E_typeid"
交叉查询 = ssql
End Function
Sub 追加查询()
Dim rs0 As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim ssql As String
Dim i As Long
ssql = 交叉查询(联合查询)
rs0.Open "N_order", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rs1.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
For i = 1 To rs1.RecordCount
rs0.AddNew
rs0!Author = rs1!Author
rs0!submitted = rs1!bs
rs0!bulletin = rs1![17]
rs0![Public] = rs1![16]
rs0!Administrative = rs1![5]
rs0!County = rs1![4]
rs0!Video = rs1![8]
rs0!Integral = Nz(rs1![17], 0) * 1.2 + Nz(rs1![16], 0) + Nz(rs1![5], 0) + Nz(rs1![4], 0) + Nz(rs1![8], 0) * 1.5
rs0!used = Nz(rs1![17], 0) + Nz(rs1![16], 0) + Nz(rs1![5], 0) + Nz(rs1![4], 0) + Nz(rs1![8], 0)
rs0.Update
rs1.MoveNext
Next
rs0.Close
rs1.Close
Set rs0 = Nothing
Set rs1 = Nothing
End Sub
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|