【筛选批量更新记录】【生成表查询示例】【生成分组数据表】
筛选批量更新记录
Private Sub Command更新价格_Click()
Dim changeprice As Currency
Dim a1 As String
a1 = InputBox("请输入调整的价格（+增加，-为减少）")
If a1 <> "" And IsNumeric(a1) = True Then
changeprice = CCur(a1)
Else
MsgBox "数据不符合规范"
End If
Dim search_rs As DAO.Recordset
Dim search_sql As String
If Me.选择类别 <> "" Then
search_sql = "Select * From 商品价格表 Where 类别='" & Me.选择类别 & "'"
Else
search_sql = "Select * From 商品价格表"
End If
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
Dim np As Currency
Do While search_rs.EOF = False
search_rs.Edit
np = search_rs!价格.Value
search_rs!价格.Value = np + changeprice
search_rs.Update
search_rs.MoveNext
Loop
search_rs.Close
Set search_rs = Nothing
Me.数据表子窗体.Requery
End Sub
Private Sub Command全部记录_Click()
Me.选择类别 = ""
Me.数据表子窗体.Form.FilterOn = False
End Sub
Private Sub 选择类别_Change()
If Me.选择类别 <> "" Then
Me.数据表子窗体.Form.Filter = "类别='" & Me.选择类别 & "'"
Me.数据表子窗体.Form.FilterOn = True
Else
Me.数据表子窗体.Form.FilterOn = False
End If
End Sub
生成表查询示例
Public filter_text As String '定义为公共变量
Private Sub Command查询_Click()
filter_text = ""
If Me.员工编号 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 员工编号 like '*" & Me.员工编号 & "*'"
Else
filter_text = "员工编号 like '*" & Me.员工编号 & "*'"
End If
End If
If Me.部门 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 部门 like '*" & Me.部门 & "*'"
Else
filter_text = "部门 like '*" & Me.部门 & "*'"
End If
End If
If Me.职位 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 职位 like '*" & Me.职位 & "*'"
Else
filter_text = "职位 like '*" & Me.职位 & "*'"
End If
End If
If Me.姓名 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 姓名 like '*" & Me.姓名 & "*'"
Else
filter_text = "姓名 like '*" & Me.姓名 & "*'"
End If
End If
If Me.销售日期1 <> "" And Me.销售日期2 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 销售日期 between #" & Me.销售日期1 & "# and #" & Me.销售日期2 & "#"
Else
filter_text = "销售日期 between #" & Me.销售日期1 & "# and #" & Me.销售日期2 & "#"
End If
End If
If Me.销售额1 <> "" And Me.销售额2 <> "" Then
If filter_text <> "" Then
filter_text = filter_text & " and 销售额 >= " & Me.销售额1 & " and 销售额<=" & Me.销售额2
Else
filter_text = "销售额 >= " & Me.销售额1 & " and 销售额<=" & Me.销售额2
End If
End If
'------------------------------筛选子窗体
If filter_text <> "" Then
Me.数据表子窗体.Form.Filter = filter_text
Me.数据表子窗体.Form.FilterOn = True
Else
Me.数据表子窗体.Form.FilterOn = False
End If
End Sub
Private Sub Command清空_Click()
员工编号.Value = ""
姓名.Value = ""
部门.Value = ""
职位.Value = ""
销售日期1.Value = ""
销售日期2.Value = ""
销售额1.Value = ""
销售额2.Value = ""
End Sub
Private Sub Command全部_Click()
Me.数据表子窗体.Form.FilterOn = False
End Sub
生成分组数据表
Private Sub Command生成_Click()
Dim group_name As String
Dim data_table As String
If Me.原数据表 <> "" And Me.分组字段 <> "" Then
data_table = Me.原数据表
group_name = Me.分组字段
Else
MsgBox "请输入原数据表和分组字段名称"
End If
Dim table_sql As String
Dim group_sql As String
group_sql = "Select " & group_name & " From " & data_table & " Group By " & group_name
Dim rs1 As Recordset
Set rs1 = CurrentDb.OpenRecordset(group_sql, dbOpenDynaset)
Do While rs1.EOF = False
'生成表
table_sql = "select * into " & rs1.Fields(group_name) & " from (select * from " & data_table & " where " & group_name & " = '" & rs1.Fields(group_name) & "')"
DoCmd.SetWarnings (False)
DoCmd.RunSQL table_sql
rs1.MoveNext
Loop
End Sub
