设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 求教，在原有的代码基础上，添加查询条件！！！
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2211|回复: 6

[已解决]求教，在原有的代码基础上，添加查询条件！！！

[复制链接]
发表于 2013-3-3 12:20 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
2013-03-03_121936.jpg 查询条件.rar (16.76 KB, 下载次数: 8)
查询, 基础

相关帖子

excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2013-3-3 12:30 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
再加上WHERER条件来判断。
回复

使用道具 举报

发表于 2013-3-3 12:38 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
输入 甲 查询 供应商 为 甲的记录
什么也不输入 查询 所有供应商的记录

296172-VBA-SQL-增加查询条件.zip (18.44 KB, 下载次数: 14)
回复

使用道具 举报

hwc2ycy
发表于 2013-3-3 12:50 | 显示全部楼层
  1. Private Sub CommandButton1_Click()
  2.     Range("M5:U65535").ClearContents
  3.     Dim cn As New ADODB.Connection, sql As String
  4.     Dim SQdate As String
  5.     Application.ScreenUpdating = False
  6.     t = Timer
  7.     Dim SQ1$, SQ2$
  8.     Dim MROW&, XROW&
  9.     MROW = Sheets("sheet1").Range("B65536").End(xlUp).Row    '取工作表有数据的最大行号，本例以E列
  10.     XROW = Sheets("sheet2").Range("B65536").End(xlUp).Row
  11.     If Len([N1]) > 0 And Len([R1]) > 0 Then SQdate = " WHERE 日期 between #" & [N1] & "# AND #" & [R1] & "# "
  12.    
  13.     If Len([m3]) > 0 Then SQdate = SQdate & "and " & [m2] & " like " & """" & [m3] & """" & " "
  14.     If Len([n3]) > 0 Then SQdate = SQdate & "and " & [n2] & " like " & """" & [n3] & """" & " "
  15.     If Len([o3]) > 0 Then SQdate = SQdate & "and " & [o2] & " like " & """" & [o3] & """" & " "
  16.     If Len([p3]) > 0 Then SQdate = SQdate & "and " & [p2] & " like " & """" & [p3] & """" & " "
  17.     If Len([q3]) > 0 Then SQdate = SQdate & "and " & [p2] & " like " & """" & [q3] & """" & " "
  18.    
  19.    
  20.    
  21.     cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
  22.     sql = "select 货品编号,供应商,产地,品名,规格,sum(进货数量) as 量,单位,sum(进货总金额) as 金额 from [sheet1$B4:K]" & SQdate & " GROUP BY 货品编号,供应商,产地,品名,规格,单位"
  23.     Sheet1.Range("m5").CopyFromRecordset cn.Execute(sql)
  24.     cn.Close
  25.     Set cn = Nothing
  26.     Application.ScreenUpdating = True
  27.     MsgBox "查询完成"
  28. End Sub
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2013-3-3 12:57 | 显示全部楼层
  1. Private Sub CommandButton1_Click()
  2.     Range("M5:U65535").ClearContents
  3.     Dim cn As New ADODB.Connection, sql As String
  4.     Dim SQdate As String
  5.     Application.ScreenUpdating = False
  6.     t = Timer
  7.     Dim SQ1$, SQ2$
  8.     Dim MROW&, XROW&
  9.     MROW = Sheets("sheet1").Range("B65536").End(xlUp).Row    '取工作表有数据的最大行号，本例以E列
  10.     XROW = Sheets("sheet2").Range("B65536").End(xlUp).Row
  11.     If Len([N1]) > 0 And Len([R1]) > 0 Then SQdate = " WHERE 日期 between #" & [N1] & "# AND #" & [R1] & "# "
  12.    
  13.     If Len([m3]) > 0 Then SQdate = SQdate & "and " & [m2] & " like " & "'" & [m3] & "'" & " "
  14.     If Len([n3]) > 0 Then SQdate = SQdate & "and " & [n2] & " like " & "'" & [n3] & "'" & " "
  15.     If Len([o3]) > 0 Then SQdate = SQdate & "and " & [o2] & " like " & "'" & [o3] & "'" & " "
  16.     If Len([p3]) > 0 Then SQdate = SQdate & "and " & [p2] & " like " & "'" & [p3] & "'" & " "
  17.     If Len([q3]) > 0 Then SQdate = SQdate & "and " & [q2] & " like " & "'" & [q3] & "'" & " "
  18.     If Len([r3]) > 0 Then SQdate = SQdate & "and " & [r2] & " >= " & [r3] & " "
  19.     If Len([s3]) > 0 Then SQdate = SQdate & "and " & [s2] & " like " & "'" & [s3] & "'" & " "
  20.     If Len([t3]) > 0 Then SQdate = SQdate & "and " & [t2] & ">=" & [t3] & " "
  21.    
  22.    
  23.    
  24.     cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
  25.     sql = "select 货品编号,供应商,产地,品名,规格,sum(进货数量) as 量,单位,sum(进货总金额) as 金额 from [sheet1$B4:K]" & SQdate & " GROUP BY 货品编号,供应商,产地,品名,规格,单位"
  26.     Sheet1.Range("m5").CopyFromRecordset cn.Execute(sql)
  27.     cn.Close
  28.     Set cn = Nothing
  29.     Application.ScreenUpdating = True
  30.     MsgBox "查询完成"
  31. End Sub
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2013-3-3 13:07 | 显示全部楼层
原来写的没考虑到总输出。
重新写了。
  1. Private Sub CommandButton1_Click()
  2.     Range("M5:U65535").ClearContents
  3.     Dim cn As New ADODB.Connection, sql As String
  4.     Dim SQdate As String
  5.     Application.ScreenUpdating = False
  6.     t = Timer
  7.     Dim SQ1$, SQ2$
  8.     Dim MROW&, XROW&
  9.     MROW = Sheets("sheet1").Range("B65536").End(xlUp).Row    '取工作表有数据的最大行号，本例以E列
  10.     XROW = Sheets("sheet2").Range("B65536").End(xlUp).Row
  11.     If Len([N1]) > 0 And Len([R1]) > 0 Then SQdate = " WHERE 日期 between #" & [N1] & "# AND #" & [R1] & "# "
  12.     SQ2 = " WHERE "
  13.     If Len([m3]) > 0 Then SQ2 = SQ2 & [m2] & " like " & "'" & [m3] & "'" & " "
  14.     If Len([n3]) > 0 Then SQ2 = SQ2 & "and " & [n2] & " like " & "'" & [n3] & "'" & " "
  15.     If Len([o3]) > 0 Then SQ2 = SQ2 & "and " & [o2] & " like " & "'" & [o3] & "'" & " "
  16.     If Len([p3]) > 0 Then SQ2 = SQ2 & "and " & [p2] & " like " & "'" & [p3] & "'" & " "
  17.     If Len([q3]) > 0 Then SQ2 = SQ2 & "and " & [q2] & " like " & "'" & [q3] & "'" & " "
  18.     If Len([r3]) > 0 Then SQ2 = SQ2 & "and 量 " & " >= " & [r3] & " "
  19.     If Len([s3]) > 0 Then SQ2 = SQ2 & "and " & [s2] & " like " & "'" & [s3] & "'" & " "
  20.     If Len([t3]) > 0 Then SQ2 = SQ2 & "and 金额 " & ">=" & [t3] & " "
  21.     cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
  22.     sql = "select *  from (select 货品编号,供应商,产地,品名,规格,sum(进货数量) as 量,单位,sum(进货总金额) as 金额 from [sheet1$B4:K]" & SQdate & " GROUP BY 货品编号,供应商,产地,品名,规格,单位) " & SQ2
  23.     Sheet1.Range("m5").CopyFromRecordset cn.Execute(sql)
  24.     cn.Close
  25.     Set cn = Nothing
  26.     Application.ScreenUpdating = True
  27.     MsgBox "查询完成"
  28. End Sub
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2013-3-3 13:09 | 显示全部楼层    本楼为最佳答案   
本帖最后由 hwc2ycy 于 2013-3-3 13:18 编辑

继续改，又发现问题了，，上面一排的条件均可引用。
  1. Private Sub CommandButton1_Click()
  2.     Range("M5:U65535").ClearContents
  3.     Dim cn As New ADODB.Connection, sql As String
  4.     Dim SQdate As String
  5.     Application.ScreenUpdating = False
  6.     t = Timer
  7.     Dim SQ1$, SQ2$
  8.     Dim MROW&, XROW&
  9.     MROW = Sheets("sheet1").Range("B65536").End(xlUp).Row    '取工作表有数据的最大行号，本例以E列
  10.     XROW = Sheets("sheet2").Range("B65536").End(xlUp).Row
  11.     If Len([N1]) > 0 And Len([R1]) > 0 Then SQdate = " WHERE 日期 between #" & [N1] & "# AND #" & [R1] & "# "
  12.      SQ2 = " where "
  13.     If Len([m3]) > 0 Then SQ2 = SQ2 & [m2] & " like " & "'" & [m3] & "'" & " and "
  14.     If Len([n3]) > 0 Then SQ2 = SQ2 & [n2] & " like " & "'" & [n3] & "'" & " and "
  15.     If Len([o3]) > 0 Then SQ2 = SQ2 & [o2] & " like " & "'" & [o3] & "'" & " and "
  16.     If Len([p3]) > 0 Then SQ2 = SQ2 & [p2] & " like " & "'" & [p3] & "'" & " and "
  17.     If Len([q3]) > 0 Then SQ2 = SQ2 & [q2] & " like " & "'" & [q3] & "'" & " and "
  18.     If Len([r3]) > 0 Then SQ2 = SQ2 & " 量 " & " >= " & [r3] & " and "
  19.     If Len([s3]) > 0 Then SQ2 = SQ2 & [s2] & " like " & "'" & [s3] & "'" & " and "
  20.     If Len([t3]) > 0 Then SQ2 = SQ2 & " 金额 " & ">=" & [t3] & " and "
  21.     SQ2 = Left(SQ2, Len(SQ2) - 5)
  22.     cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
  23.     sql = "select *  from (select 货品编号,供应商,产地,品名,规格,sum(进货数量) as 量,单位,sum(进货总金额) as 金额 from [sheet1$B4:K]" & SQdate & " GROUP BY 货品编号,供应商,产地,品名,规格,单位) "
  24.     If Len(SQ2) > 8 Then
  25.         sql = sql & SQ2
  26.     End If
  27.     Sheet1.Range("m5").CopyFromRecordset cn.Execute(sql)
  28.     cn.Close
  29.     Set cn = Nothing
  30.     Application.ScreenUpdating = True
  31.     MsgBox "查询完成"
  32. End Sub
复制代码
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-19 10:47 , Processed in 1.657159 second(s), 13 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表