[已解决]求助各位老师VBA是否能实现窗口单选项按纽的多项查询（有难度）

qinhuan66

求助各位老师，能否帮实现下图的窗口单选项按纽（1、姓名；2、医保卡号；3、单位名称；4、定点医疗机构名称），输入单选项按纽所对应的内容到查询内容（比如单选选择为姓名，则查询内容即输入所要查询的姓名），再根据下面的开始时间和结束时间来查询（从Microsoft Access数据库根据上述来提取相应数据A6:AG65536）,忘记说了，开始时间和结束时间是根据数据的录入时间来判断。

模糊查询(测试).rar (38.14 KB, 下载次数: 20)

2013-5-19 11:06 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-19 14:35

窗体代码。

1. Option Explicit
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4.     Dim strSql$
   
5.     Dim strFind$
   
6.     Dim strCondition1$
   
7.     Dim strCondition2$
   
8.     Dim Database As String
   
9. 
   
10.     On Error GoTo Errcheck
    
11. 
    
12.     Select Case True
    
13.         Case Me.OptionButton1.Value
    
14.             strFind = OptionButton1.Caption
    
15.         Case Me.OptionButton2.Value
    
16.             strFind = OptionButton2.Caption
    
17.         Case Me.OptionButton3.Value
    
18.             strFind = OptionButton3.Caption
    
19.         Case Me.OptionButton4.Value
    
20.             strFind = OptionButton4.Caption
    
21.         Case Else
    
22.             MsgBox "请选择要查找的内容"
    
23.             Exit Sub
    
24.     End Select
    
25. 
    
26.     Database = "data"
    
27.     strSql = "select 报销月份,序号,定点医疗机构名称,医保卡号,单位名称,姓名,性别," & _
    
28.              "年龄,入院日期,出院日期,住院天数,出院诊断,本次住院医疗费总额,甲类药费," & _
    
29.              "乙类药费,进口药费,自费药费,超出范围,进口材料费,国产材料费," & _
    
30.              "特殊检查费特殊治疗费,丙类项目,其它费用,起付段金额,个人政策自付小计," & _
    
31.              "自费药品及自费项目,实际结算自付,统筹基金支付,大病求助基金支付," & _
    
32.              "个人支付金额,本年住院次数,本年范围内费用累计,本年大病范围内费用累计 from " & Database
    
33. 
    
34.     Select Case True
    
35.         Case Len(Me.TextBox1.Text) > 0
    
36.             strCondition1 = " where " & strFind & "='" & Me.TextBox1.Text & "' "
    
37.         Case Else
    
38.             strCondition1 = " where " & strFind & " like '%' "
    
39.     End Select
    
40. 
    
41. 
    
42.     Select Case True
    
43.         Case Len(Me.TextBox2.Text) = 0 And Len(Me.TextBox3.Text) = 0
    
44.         Case Len(Me.TextBox2.Text) = 0
    
45.             strCondition2 = " and 录入时间<=#" & Me.TextBox3.Text & "#"
    
46.         Case Len(Me.TextBox3.Text) = 0
    
47.             strCondition2 = " and 录入时间>=#" & Me.TextBox2.Text & "#"
    
48.         Case Else
    
49.             strCondition2 = " and  录入时间 between #" & Me.TextBox2.Text & "# and #" & Me.TextBox3.Text & "#"
    
50.     End Select
    
51. 
    
52.     MsgBox strSql & strCondition1 & strCondition2
    
53.     Call ADOQuery(strSql & strCondition1 & strCondition2)
    
54.     Exit Sub
    
55.    
    
56. Errcheck:
    
57.     MsgBox Err.Number & vbNewLine & _
    
58.            Err.Description
    
59. 
    
60. End Sub
    
61. 
    
62. 
    
63. Private Sub CommandButton2_Click()
    
64.     Unload Me
    
65. End Sub
    
66. 
    
67. 
    
68. Sub ADOQuery(strSql As String)
    
69. 
    
70.     Dim AdoConn As Object, AdoRst As Object
    
71.     Dim StrConn$
    
72.     Dim AccessFile As String
    
73.    
    
74.    
    
75.     AccessFile = ThisWorkbook.Path & "\data.mdb"
    
76.     If Dir(AccessFile) = "" Then
    
77.         MsgBox "ACCESS数据文件不存在"
    
78.         Exit Sub
    
79.     End If
    
80. 
    
81. 
    
82. 
    
83.     Range("A6:AG65536").ClearContents
    
84.     With Sheets("报销统计综合查询")
    
85.         .Unprotect ("695360052")
    
86.         .Protect ("695360052")
    
87.     End With
    
88. 
    
89.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
90.               "Data Source=" & AccessFile & ";"""
    
91. 
    
92.     Set AdoConn = CreateObject("ADODB.Connection")
    
93.     With AdoConn
    
94.         .CursorLocation = 3    '游标类型
    
95.         .CommandTimeout = 5    '超时
    
96.         .connectionTimeout = 5  '超时
    
97.         .Open StrConn       '打开
    
98.     End With
    
99. 
    
100.     Set AdoRst = AdoConn.Execute(strSql)
     
101. 
     
102.     If AdoRst.RecordCount = 0 Then
     
103.         MsgBox "无合乎条件的数据"
     
104.         Exit Sub
     
105.     Else
     
106.         Application.ScreenUpdating = False
     
107.         Range("a6").CopyFromRecordset AdoRst
     
108.     End If
     
109.     AdoConn.Close
     
110.     Set AdoConn = Nothing
     
111.     Application.ScreenUpdating = True
     
112.     MsgBox "查询完成"
     
113.     Exit Sub
     
114. 
     
115. Errcheck:
     
116.     MsgBox Err.Number & vbNewLine & _
     
117.            Err.Description
     
118. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

只要条件明确，都是可以的。

qinhuan66

hwc2ycy 发表于 2013-5-19 13:56
只要条件明确，都是可以的。

老师您好！能否抽点时间帮我弄一下。拜托了。

hwc2ycy

窗体代码。

1. Option Explicit
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4.     Dim strSql$
   
5.     Dim strFind$
   
6.     Dim strCondition1$
   
7.     Dim strCondition2$
   
8.     Dim Database As String
   
9. 
   
10.     On Error GoTo Errcheck
    
11. 
    
12.     Select Case True
    
13.         Case Me.OptionButton1.Value
    
14.             strFind = OptionButton1.Caption
    
15.         Case Me.OptionButton2.Value
    
16.             strFind = OptionButton2.Caption
    
17.         Case Me.OptionButton3.Value
    
18.             strFind = OptionButton3.Caption
    
19.         Case Me.OptionButton4.Value
    
20.             strFind = OptionButton4.Caption
    
21.         Case Else
    
22.             MsgBox "请选择要查找的内容"
    
23.             Exit Sub
    
24.     End Select
    
25. 
    
26.     Database = "data"
    
27.     strSql = "select 报销月份,序号,定点医疗机构名称,医保卡号,单位名称,姓名,性别," & _
    
28.              "年龄,入院日期,出院日期,住院天数,出院诊断,本次住院医疗费总额,甲类药费," & _
    
29.              "乙类药费,进口药费,自费药费,超出范围,进口材料费,国产材料费," & _
    
30.              "特殊检查费特殊治疗费,丙类项目,其它费用,起付段金额,个人政策自付小计," & _
    
31.              "自费药品及自费项目,实际结算自付,统筹基金支付,大病求助基金支付," & _
    
32.              "个人支付金额,本年住院次数,本年范围内费用累计,本年大病范围内费用累计 from " & Database
    
33. 
    
34.     Select Case True
    
35.         Case Len(Me.TextBox1.Text) > 0
    
36.             strCondition1 = " where " & strFind & "='" & Me.TextBox1.Text & "' "
    
37.         Case Else
    
38.             strCondition1 = " where " & strFind & " like '%' "
    
39.     End Select
    
40. 
    
41. 
    
42.     Select Case True
    
43.         Case Len(Me.TextBox2.Text) = 0 And Len(Me.TextBox3.Text) = 0
    
44.         Case Len(Me.TextBox2.Text) = 0
    
45.             strCondition2 = " and 录入时间<=#" & Me.TextBox3.Text & "#"
    
46.         Case Len(Me.TextBox3.Text) = 0
    
47.             strCondition2 = " and 录入时间>=#" & Me.TextBox2.Text & "#"
    
48.         Case Else
    
49.             strCondition2 = " and  录入时间 between #" & Me.TextBox2.Text & "# and #" & Me.TextBox3.Text & "#"
    
50.     End Select
    
51. 
    
52.     MsgBox strSql & strCondition1 & strCondition2
    
53.     Call ADOQuery(strSql & strCondition1 & strCondition2)
    
54.     Exit Sub
    
55.    
    
56. Errcheck:
    
57.     MsgBox Err.Number & vbNewLine & _
    
58.            Err.Description
    
59. 
    
60. End Sub
    
61. 
    
62. 
    
63. Private Sub CommandButton2_Click()
    
64.     Unload Me
    
65. End Sub
    
66. 
    
67. 
    
68. Sub ADOQuery(strSql As String)
    
69. 
    
70.     Dim AdoConn As Object, AdoRst As Object
    
71.     Dim StrConn$
    
72.     Dim AccessFile As String
    
73.    
    
74.    
    
75.     AccessFile = ThisWorkbook.Path & "\data.mdb"
    
76.     If Dir(AccessFile) = "" Then
    
77.         MsgBox "ACCESS数据文件不存在"
    
78.         Exit Sub
    
79.     End If
    
80. 
    
81. 
    
82. 
    
83.     Range("A6:AG65536").ClearContents
    
84.     With Sheets("报销统计综合查询")
    
85.         .Unprotect ("695360052")
    
86.         .Protect ("695360052")
    
87.     End With
    
88. 
    
89.     StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
90.               "Data Source=" & AccessFile & ";"""
    
91. 
    
92.     Set AdoConn = CreateObject("ADODB.Connection")
    
93.     With AdoConn
    
94.         .CursorLocation = 3    '游标类型
    
95.         .CommandTimeout = 5    '超时
    
96.         .connectionTimeout = 5  '超时
    
97.         .Open StrConn       '打开
    
98.     End With
    
99. 
    
100.     Set AdoRst = AdoConn.Execute(strSql)
     
101. 
     
102.     If AdoRst.RecordCount = 0 Then
     
103.         MsgBox "无合乎条件的数据"
     
104.         Exit Sub
     
105.     Else
     
106.         Application.ScreenUpdating = False
     
107.         Range("a6").CopyFromRecordset AdoRst
     
108.     End If
     
109.     AdoConn.Close
     
110.     Set AdoConn = Nothing
     
111.     Application.ScreenUpdating = True
     
112.     MsgBox "查询完成"
     
113.     Exit Sub
     
114. 
     
115. Errcheck:
     
116.     MsgBox Err.Number & vbNewLine & _
     
117.            Err.Description
     
118. End Sub

复制代码

hwc2ycy

报销统计录入.rar (34.95 KB, 下载次数: 21)

2013-5-19 14:39 上传

点击文件名下载附件

hwc2ycy

只要求对要查询的项目做要求，三个TEXTBOX可不输入内容，会做模糊查询的处理。

qinhuan66

hwc2ycy 发表于 2013-5-19 14:39

老师您好！开始时间和结束时间的文本框能否只限输入日期或换成日期控件。谢谢

hwc2ycy

qinhuan66 发表于 2013-5-19 16:37
老师您好！开始时间和结束时间的文本框能否只限输入日期或换成日期控件。谢谢

可以的，建议就用文本框，对输入的文本进行判断。

qinhuan66

hwc2ycy 发表于 2013-5-19 17:08
可以的，建议就用文本框，对输入的文本进行判断。

老师请教您一下。为什么我文本框内设限为日期型输入2013-4-5他说不是日期的

Private Sub TextBox2_Change()
   If Not IsNumeric(TextBox2) Then
MsgBox "不是日期"
TextBox2 = ""
End If
End Sub

hwc2ycy

这个方法不对。
用isdate函数
isdate(me.textbox2.text)