求助：按条件查询

jjj2123456? · 发表于 2015-2-8 14:39

本帖最后由 jjj2123456? 于 2015-2-8 14:46 编辑

打开窗体

在ID号对应的combobox中写入1，那么就在数据库提取这一行数据到工作表，在编号写入cmz150101那么就在数据库提取这一行数据到工作表，单号、年、月、日同理

如果什么都不写，那么就提取数据库所有的数据到工作表

新建文件夹 (2).zip (118.9 KB, 下载次数: 11)
Sub 数据库数据写入工作表()
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim myPath As String
Dim SQL As String
Dim i As Integer
On Error GoTo errmsg
myPath = ThisWorkbook.Path & "\jiageguanli.mdb"
myTable = ActiveSheet.Name
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
For Each sh In Worksheets
      If sh.Name = myTable Then
         SQL = "SELECT * FROM " & myTable
         Set rs = cnn.Execute(SQL)
         sh.Range("A1").CurrentRegion.ClearContents
         For i = 0 To rs.Fields.Count - 1
            sh.Cells(1, i + 1) = rs.Fields(i).Name
         Next
         sh.Range("A2").CopyFromRecordset rs
      End If
Next
MsgBox "读出access数据完毕。", vbInformation
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Exit Sub
errmsg:
MsgBox Err.Description, , "错误报告"
End Sub
这段代码是论坛一位老师帮我写的，现在只可以把数据库里面的所有数据提取到工作表，我想按条件提取不知道可否实现。

jjj2123456? · 发表于 2015-2-8 15:55

希望路过的老师帮帮忙

zhaogang1960 · 发表于 2015-2-8 18:25

第一步，基本设置：

Dim cnn As ADODB.Connection '模块级变量
Dim rs As ADODB.Recordset
Dim myTable As String
Dim arr As Variant
Private Sub CommandButton2_Click() '退出
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '关闭窗体时断开连接，释放内存
On Error Resume Next
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub
Private Sub UserForm_Initialize() '开启窗体设置6个ComboBox
Dim i As Integer
Dim SQL As String
arr = Array("ID号", "编号", "单号", "年", "月", "日")
myTable = "数据"
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\jiageguanli.mdb" '连接数据库
For i = 1 To 6
SQL = "SELECT DISTINCT " & arr(i - 1) & " FROM " & myTable
Set rs = cnn.Execute(SQL)
Me.Controls("ComboBox" & i).Column = rs.GetRows
Next
End Sub

复制代码

zhaogang1960 · 发表于 2015-2-8 18:26

第二步，查询程序

Private Sub CommandButton1_Click() '确定
Dim s As String
Dim i As Integer
Dim SQL As String
If Len(ComboBox1.Value) Then s = s & " and " & arr(0) & "=" & ComboBox1.Value
For i = 2 To 6
If Len(Me.Controls("ComboBox" & i).Value) Then s = s & " and " & arr(i - 1) & "='" & Me.Controls("ComboBox" & i).Value & "'"
Next
SQL = "SELECT * FROM " & myTable
If Len(s) Then SQL = SQL & " WHERE " & Mid(s, 6)
Set rs = cnn.Execute(SQL)
If Not rs.EOF Then
With Sheets("数据")
.UsedRange.Offset(1).ClearContents
.[a2].CopyFromRecordset rs
End With
Else
MsgBox "没有查到"
End If
End Sub

复制代码

zhaogang1960 · 发表于 2015-2-8 18:28

请测试附件

新建文件夹 (2).rar (75.94 KB, 下载次数: 45)

jjj2123456? · 发表于 2015-2-8 19:16

zhaogang1960 发表于 2015-2-8 18:28
请测试附件

感谢老师！
已经可以实现了。

此用户被禁言 · 发表于 2015-2-9 15:16

zhaogang1960 发表于 2015-2-8 18:28
请测试附件

赵老师，你好，能否看一下这里的问题，谢谢，ADO查询后。得出的数据少了，65536行后的数据都没有了

http://club.excelhome.net/thread-1163082-2-1.html

zhaogang1960 · 发表于 2015-2-9 16:01

此用户被禁言发表于 2015-2-9 15:16
赵老师，你好，能否看一下这里的问题，谢谢，ADO查询后。得出的数据少了，65536行后的数据都没有了

ht ...

从你的1楼看不出来问题，后面的代码我看不懂，请重新发新帖求助，并通知我网址

此用户被禁言 · 发表于 2015-2-9 16:17

zhaogang1960 发表于 2015-2-9 16:01
从你的1楼看不出来问题，后面的代码我看不懂，请重新发新帖求助，并通知我网址

赵老师，发了新的地址了，谢谢

http://club.excelhome.net/forum. ... =1186317&extra=

zhaogang1960 · 发表于 2015-2-9 16:25

此用户被禁言发表于 2015-2-9 16:17
赵老师，发了新的地址了，谢谢

http://club.excelhome.net/forum.php?mod=viewthread&tid=1186317&ext ...

你这是一碗豆腐换成了豆腐一碗，我要的是你的具体要求，不是修改代码，我没有时间看懂别人写的代码

		自动登录	找回密码
密码			免费注册

求助：按条件查询

评分

评分

评分