用VBA代码+DAO生成带条件的交叉表查询
Option Compare Database
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'由浅入深的介绍几种最常用的利用主/子窗体来实现查询的方法，
'使初学者和有一定VBA基础的人可以更好的使用窗体查询这种手段。
'本例程是讲解用VBA代码+DAO生成带条件的交叉表查询。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub cmd查询_Click()
On Error GoTo Err_cmd查询_Click
Dim strWhere As String '定义条件字符串
Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象
Dim strSQL As String
strWhere = "" '设定初始值－空字符串
'判断【类别】条件是否有输入的值
If Not IsNull(Me.类别) Then
'有输入
strWhere = strWhere & "([类别] like '" & Me.类别 & "') AND "
End If
'判断【出版社】条件是否有输入的值
If Not IsNull(Me.出版社) Then
'有输入
strWhere = strWhere & "([出版社] like '" & Me.出版社 & "') AND "
End If
'判断【单价】条件是否有输入的值，由于有【单价开始】【单价截止】两个文本框
'所以要分开来考虑
If Not IsNull(Me.单价开始) Then
'【单价开始】有输入
strWhere = strWhere & "([单价] >= " & Me.单价开始 & ") AND "
End If
If Not IsNull(Me.单价截止) Then
'【单价截止】有输入
strWhere = strWhere & "([单价] <= " & Me.单价截止 & ") AND "
End If
'判断【进书日期】条件是否有输入的值，由于有【进书日期开始】【进书日期截止】两个文本框
'所以要分开来考虑
If Not IsNull(Me.进书日期开始) Then
'【进书日期开始】有输入
strWhere = strWhere & "([进书日期] >= #" & Format(Me.进书日期开始, "yyyy-mm-dd") & "#) AND "
End If
If Not IsNull(Me.进书日期截止) Then
'【进书日期截止】有输入
strWhere = strWhere & "([进书日期] <= #" & Format(Me.进书日期截止, "yyyy-mm-dd") & "#) AND "
End If
'如果输入了条件，那么strWhere的最后肯定有" AND "，这是我们不需要的，
'要用LEFT函数截掉这5个字符。
If Len(strWhere) > 0 Then
'有输入条件
strWhere = Left(strWhere, Len(strWhere) - 5)
End If
'先在立即窗口显示一下strWhere的值，代码调试完成后可以取消下一句
'Debug.Print strWhere
'根据是否有条件来设定交叉表查询的SQL语句
If Len(strWhere) > 0 Then
strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum Select 存书查询.类别 FROM 存书查询 "
strSQL = strSQL & "Where(" & strWhere
strSQL = strSQL & ") GROUP BY 存书查询.类别 PIVOT Format([进书日期],'yyyy/mm')"
Else
strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum" & _
" Select 存书查询.类别" & _
" FROM 存书查询" & _
" GROUP BY 存书查询.类别" & _
" PIVOT Format([进书日期],'yyyy/mm')"
End If
'修改交叉表查询的SQL语句
Set qdf = CurrentDb.QueryDefs("存书查询_交叉表")
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
'显示交叉表的内容，不能直接刷新
Me.存书查询子窗体.SourceObject = ""
Me.存书查询子窗体.SourceObject = "查询.存书查询_交叉表"
'刷新计数和合计显示
Me.计数 = DCount("*", "存书查询_交叉表")
Me.合计 = DSum("[单价]", "存书查询", strWhere)
Exit_cmd查询_Click:
Exit Sub
Err_cmd查询_Click:
MsgBox Err.Description
Resume Exit_cmd查询_Click
End Sub
Private Sub cmd导出_Click()
On Error GoTo Err_cmd导出_Click
'由于前面我们已经通过DAO修改了“存书查询_交叉表”的SQL语句，
'所以这里我们直接导出就可以了。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
DoCmd.OutputTo acOutputQuery, "存书查询_交叉表", acFormatXLS, , True
Exit_cmd导出_Click:
Exit Sub
Err_cmd导出_Click:
MsgBox Err.Description
Resume Exit_cmd导出_Click
End Sub
Private Sub cmd清除_Click()
On Error GoTo Err_cmd清除_Click
'这里将使用FOR EACH CONTROL的方法来清除控件的值
'这在控件比较多的时候非常有用。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim ctl As Control
Dim qdf As DAO.QueryDef 'qdf被定义为一个查询定义对象
Dim strSQL As String
For Each ctl In Me.Controls
'根据ctl的控件类型来选择
Select Case ctl.ControlType
Case acTextBox '是文本框，要清空(注意，子窗体下面还有两个锁定的文本框不能赋值)
If ctl.Locked = False Then ctl.Value = Null
Case acComboBox '是组合框，也要清空
ctl.Value = Null
'其它类型的控件不处理
End Select
Next
strSQL = "TRANSFORM Sum(存书查询.单价) AS 单价之Sum" & _
" Select 存书查询.类别" & _
" FROM 存书查询" & _
" GROUP BY 存书查询.类别" & _
" PIVOT Format([进书日期],'yyyy/mm')"
'修改交叉表查询的SQL语句
Set qdf = CurrentDb.QueryDefs("存书查询_交叉表")
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
'显示交叉表的内容，不能直接刷新
Me.存书查询子窗体.SourceObject = ""
Me.存书查询子窗体.SourceObject = "查询.存书查询_交叉表"
'刷新计数和合计显示
Me.计数 = DCount("*", "存书查询_交叉表")
Me.合计 = DSum("[单价]", "存书查询")
Exit_cmd清除_Click:
Exit Sub
Err_cmd清除_Click:
MsgBox Err.Description
Resume Exit_cmd清除_Click
End Sub
Private Sub cmd预览报表_Click()
On Error GoTo Err_cmd预览报表_Click
Dim stDocName, strWhere As String
stDocName = "藏书情况报表"
DoCmd.OpenReport stDocName, acViewPreview
Exit_cmd预览报表_Click:
Exit Sub
Err_cmd预览报表_Click:
MsgBox Err.Description
Resume Exit_cmd预览报表_Click
End Sub
Private Sub Form_Open(Cancel As Integer)
'如果没有这一段代码，窗体打开时，虽然子窗体有显示，但下面的两个文本框是空的。
'刷新计数和合计显示
Me.计数 = DCount("*", "存书查询_交叉表")
Me.合计 = DSum("[单价]", "存书查询")
End Sub
*在报表的打开事件中写：
Private Sub Report_Open(Cancel As Integer)
'根据交叉表查询的实际字段数来设定报表各节可以显示的控件数。
'需要使用DAO 3.6
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim rst As DAO.Recordset, intFieldsNum As Integer, I As Integer
'打开查询
Set rst = CurrentDb.OpenRecordset("Select * FROM [存书查询_交叉表] Where 1=2")
rst.MoveLast
rst.MoveFirst
Debug.Print rst.RecordCount
'记录字段总数
intFieldsNum = rst.Fields.Count
'由于报表仅有10个可变字段＋1个固定字段，所以，如果字段总数>11时，
'只显示前面的11个字段，并给出提示。
If intFieldsNum > 11 Then
intFieldsNum = 11
MsgBox "字段总数太多，报表仅显示前11个字段。", vbInformation + vbOKOnly, "提示"
End If
For I = 1 To 10
If I <= (intFieldsNum - 1) Then
'有对应字段，rst.Fields(I) 中 rst.Fields(0)是第一个，是“类别”字段。
'页眉标签可见
Section(acPageHeader).Controls("标签" & I).Caption = rst.Fields(I).Name
Section(acPageHeader).Controls("标签" & I).Visible = True
'主体字段可见
Section(acDetail).Controls("txt" & I).ControlSource = rst.Fields(I).Name
Section(acDetail).Controls("txt" & I).Visible = True
'报表页脚合计可见
Section(acFooter).Controls("txt合计" & I).ControlSource = "=SUM(NZ([" & rst.Fields(I).Name & "],0))"
Section(acFooter).Controls("txt合计" & I).Visible = True
Else
'没有对应字段
'页眉标签不可见
Section(acPageHeader).Controls("标签" & I).Visible = False
'主体字段不可见
Section(acDetail).Controls("txt" & I).ControlSource = ""
Section(acDetail).Controls("txt" & I).Visible = False
'报表页脚合计可见
Section(acFooter).Controls("txt合计" & I).ControlSource = ""
Section(acFooter).Controls("txt合计" & I).Visible = False
End If
Next
rst.Close
Set rst = Nothing
End Sub
进行多条件查询, 希望某一条件为空时显示全部
where name1 like *temp1* and name2 like *temp2*
如何判断奇数（单数）、偶数（双数）？
dim a as string
(这里有一段给a赋值的代码）
if a mod 2=0 then
msgbox"这是一个偶数"
esle
msgbox"这是一个奇数"
end if
计算在每个范围内的数量
本示例假设您有一个“Orders”表，且里头含有一个“Freight”字段。程序建立一个“选择”来计算运费落在某些范围内的订单数量。Partition 函数是用来确定这些范围，然后调用 SQL Count 函数来计算在每个范围内的订单数量。本示例中，Partition 函数的参数值为 start = 0，stop = 500，interval = 50。第一个范围会是 0：49，每隔 50 一个范围，依次而下直到运费为 500 为止。
Select DISTINCTROW Partition([freight],0, 500, 50) AS Range,
Count(Orders.Freight) AS Count
FROM orders
GROUP BY Partition([freight],0,500,50);
使用 Trim 函数显示字段的值，并且删除首尾的空格。
使用Trim 函数显示“地址”字段的值，并且删除首尾的空格。
=Trim([地址])
Like函数示例：
查询条件为“Like "*" & [forms]![销售单输入]![文本26]”，当我输入60时，所有包含60的记录全部得出，诸如160、260、360等
只想要60的记录，并且当不输入任何数据时，所有记录全部得出
Like IIf([forms]![销售单输入]![文本26] Is Not Null,[forms]![销售单输入]![文本26],"*")
使用 Left 函数来得到某字符串最左边的几个字符。
Dim AnyString, MyStr
AnyString = "Hello World" ' 定义字符串。
MyStr = Left(AnyString, 1) ' 返回 "H"。
MyStr = Left(AnyString, 7) ' 返回 "Hello W"。
MyStr = Left(AnyString, 20) ' 返回 "Hello World"。
使用 Mid 语句来得到某个字符串中的几个字符。
Dim MyString, FirstWord, LastWord, MidWords
MyString = "Mid Function Demo" 建立一个字符串。
FirstWord = Mid(MyString, 1, 3) ' 返回 "Mid"。
LastWord = Mid(MyString, 14, 4) ' 返回 "Demo"。
MidWords = Mid(MyString, 5) ' 返回 "Funcion Demo"。
使用 Right 函数来返回某字符串右边算起的几个字符。
Dim AnyString, MyStr
AnyString = "Hello World" ' 定义字符串。
MyStr = Right(AnyString, 1) ' 返回 "d"。
MyStr = Right(AnyString, 6) ' 返回 " World"。
MyStr = Right(AnyString, 20) ' 返回 "Hello World"。
使用 InStr 函数来查找某字符串在另一个字符串中首次出现的位置。
Dim SearchString, SearchChar, MyPos
SearchString ="XXpXXpXXPXXP" ' 被搜索的字符串。
SearchChar = "P" ' 要查找字符串 "P"。
' 从第四个字符开始，以文本比较的方式找起。返回值为 6（小写 p）。
' 小写 p 和大写 P 在文本比较下是一样的。
MyPos = Instr(4, SearchString, SearchChar, 1)
' 从第一个字符开使，以二进制比较的方式找起。返回值为 9（大写 P）。
' 小写 p 和大写 P 在二进制比较下是不一样的。
MyPos = Instr(1, SearchString, SearchChar, 0)
' 缺省的比对方式为二进制比较（最后一个参数可省略）。
MyPos = Instr(SearchString, SearchChar) ' 返回 9。
MyPos = Instr(1, SearchString, "W") ' 返回 0。
使用 Space 函数来生成一个字符串，字符串的内容为空格，长度为指定的长度。
Dim MyString
' 返回 10 个空格的字符串。
MyString = Space(10)
' 将 10 个空格插入两个字符串中间。
MyString = "Hello" & Space(10) & "World"
使用 String 函数来生成一指定长度，且只含单一字符的字符串。
Dim MyString
MyString = String(5, "*") ' 返回 "*****"。
MyString = String(5, 42) ' 返回 "*****"。
MyString = String(10, "ABC") ' 返回 "AAAAAAAAAA"。
使用 DLookup 函数
=DLookup("[联系人姓名]", "[供应商]", "[供应商ID] ="[供应商ID])
一、变量为数字
If IsNull(DLookup("[纺号]", "另一个表的名字", "[纺号] = " & 文本框的值)) Then
Msgbox "该纺号不存在!"
End If
二、变量为字符串
If IsNull(DLookup("[纺号]", "另一个表的名字", "[纺号] = '" & 文本框的值 &"'")) Then
Msgbox "该纺号不存在!"
End If
使用 Len 函数来得知某字符串的长度（字符数）或某变量的大小（位数）。
Type...End Type 程序区块定义一个自定义数据类型 CustomerRecord。如果该数据类型定义在对象类模块中，则必需以关键字 Private 开头（表示为私有）。若定义在常规模块中，Type 定义就可以为 Public。
Type CustomerRecord ' 定义用户自定义的数据类型。
ID As Integer ' 将此定义放在常规模块中。
Name As String * 10
Address As String * 30
End Type
Dim Customer As CustomerRecord ' 声明变量。
Dim MyInt As Integer, MyCur As Currency
Dim MyString, MyLen
MyString = "Hello World" ' 设置变量初值。
MyLen = Len(MyInt) ' 返回 2。
MyLen = Len(Customer) ' 返回 42。
MyLen = Len(MyString) ' 返回 11。
MyLen = Len(MyCur) ' 返回 8。
Round四舍五入。
Round(数值表达式，小数点右边应保留的位数)
用按钮在窗体中按指定字段查找记录
例一：
Private Sub 查找记录_Click()
On Error GoTo Err_查找记录_Click
''指定字段名称[学生编号]
DoCmd.GoToControl "学生编号"
DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_查找记录_Click:
Exit Sub
Err_查找记录_Click:
MsgBox Err.Description
Resume Exit_查找记录_Click
End Sub
例二
Private Sub 按毕业时间查找_Click()
On Error GoTo 按毕业时间查找_Click_Err
''在窗体中按基础表的参数筛选
DoCmd.ApplyFilter "", "Left([学生基本情况]![学生编号],4)+6=[请输入学生毕业年份(四位数)]"
按毕业时间查找_Click_Exit:
Exit Sub
按毕业时间查找_Click_Err:
MsgBox Error$
Resume 按毕业时间查找_Click_Exit
End Sub
