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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 有请“无聊疯子"大师帮忙，指正SQL查询VBA代码出错
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 2243|回复: 8

[已解决]有请“无聊疯子"大师帮忙，指正SQL查询VBA代码出错

[复制链接]
yangting
发表于 2011-9-27 19:34 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
有请“无聊疯子"大师及精英大师们帮忙，经验证添加输入、修改功能正常，但查询不反应。麻烦大师解决SQL查询VBA代码出错问题。谢谢！！！
最佳答案
月排行榜 / 总排行榜
mxg825
2011-9-28 10:32
回复 yangting 的帖子

注意：要把 【查询及添加】表的 【I8  K8 单元格】 换行符删除
  1. Sub 空数据查询()
  2. [B10:L2200].ClearContents
  3. Set xSh = ThisWorkbook.Worksheets(Sheet1.Name)
  4. Set sRan = xSh.Range("C8")
  5. Set conn = New ADODB.Connection
  6. conn.ConnectionString = _
  7. "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" _
  8. & ThisWorkbook.Path & "" & ThisWorkbook.Name
  9. conn.Open
  10. Sheet1.[C9].Select
  11. If conn.State = adStateOpen Then

  13. ' mxg825更改于20110928
  14. ' 1. 生成SQL
  15. SSQL = "SELECT * from [" & Sheet2.Name & "$]"
  16. Dim ran As Range, SQL2 As String
  17. SQL2 = " WHERE "
  18. For Each ran In Range("B9:L9")
  19. If Len(ran) > 0 Then
  20. If IsDate(ran) Then
  21. SQL2 = SQL2 & ran.Offset(-1, 0) & "=#" & ran & "# and " '日期加 [#]
  22. ElseIf IsNumeric(ran) Then
  23. SQL2 = SQL2 & ran.Offset(-1, 0) & "=" & ran & " and " '数字不用加
  24. Else
  25. SQL2 = SQL2 & ran.Offset(-1, 0) & "='" & ran & "' and " '文本加 [']
  26. End If
  27. End If
  28. Next
  29. If Len(SQL2) > 7 Then '是否添加查询条件
  30. SSQL = SSQL & Left(SQL2, Len(SQL2) - 5) '截取掉 后面多余的 [ and ] 5个字符
  31. End If
  32. ' 2. 执行插入
  33. sRan.Offset(2, -1).CopyFromRecordset conn.Execute(SSQL)

  35. conn.Close
  36. If Sheet1.[B10] = "" Then
  37. MsgBox "“" & Sheet2.Name & "”无数据！"
  38. End If
  39. End If
  40. Set conn = Nothing
  41. End Sub
复制代码

书类管理.rar

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

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
mxg825
发表于 2011-9-27 20:33 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 mxg825 于 2011-9-27 20:37 编辑

INSERT INTO 是向数据插入 数据
查询要用 SELECT 语句


sSql = "SELECT * from [" & Sheet2.Name & "$]"
WHERE.jpg
回复

使用道具 举报

yangting
 楼主| 发表于 2011-9-27 22:27 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
谢谢，mxg825 兄弟，按你的方法全部查询可以，但指定查询不行，请各高手指正更改。谢谢！！
回复

使用道具 举报

发表于 2011-9-28 00:50 | 显示全部楼层
回复 yangting 的帖子

不好意思,我不会 SQL 所以,爱莫能助!!

{:011:}{:101:}
回复

使用道具 举报

吕?布
发表于 2011-9-28 08:07 | 显示全部楼层
改了一个
Sub 空数据查询()
    [B10:L2200].ClearContents
    Set xSh = ThisWorkbook.Worksheets(Sheet1.Name)
    Set sRan = xSh.Range("C8")
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
    "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" _
                            & ThisWorkbook.Path & "\" & ThisWorkbook.Name
    conn.Open
    Sheet1.[C9].Select
    If conn.State = adStateOpen Then
        
        ' 吕布更改于20110928
        ' 1. 生成SQL
        sSql = "INSERT INTO [v数据库] " & _
               "(ID,入库日期,责任人,书类,编号,价值,密级,重新入库日期,借调日期,毁损转出日期,状态) " & _
               "VALUES (vID,v入库日期,v责任人,v书类,v编号,v价值,v密级,v重新入库日期,v借调日期,v毁损转出日期,v状态)"
        sSql = Replace(sSql, "v数据库", Sheet2.Name & "$")
        sSql = Replace(sSql, "vID", Application.Max(Sheets("数据库").Range("A2:A65000")) + 1)
        Dim i As Long, lb As Long
        Dim arrFields As Variant
        arrFields = Array("v入库日期", "v责任人", "v书类", "v编号", "v价值", "v密级", "v重新入库日期", "v借调日期", "v毁损转出日期", "v状态")
        lb = LBound(arrFields)
        For i = LBound(arrFields) To UBound(arrFields)
            sSql = Replace(sSql, arrFields(i), IIf(Len(Cells(9, i - lb + 3)) > 0, Cells(9, i - lb + 3), "Null"))
        Next i
        
        ' 2. 执行插入
        'sRan.Offset(2, -1).CopyFromRecordset
        conn.Execute (sSql)
        
        conn.Close
        If Sheet1.[B10] = "" Then
            MsgBox "“" & Sheet2.Name & "”无数据！"
        End If
    End If
    Set conn = Nothing
End Sub
回复

使用道具 举报

mxg825
发表于 2011-9-28 10:32 | 显示全部楼层    本楼为最佳答案   
回复 yangting 的帖子

注意：要把 【查询及添加】表的 【I8  K8 单元格】 换行符删除
  1. Sub 空数据查询()
  2. [B10:L2200].ClearContents
  3. Set xSh = ThisWorkbook.Worksheets(Sheet1.Name)
  4. Set sRan = xSh.Range("C8")
  5. Set conn = New ADODB.Connection
  6. conn.ConnectionString = _
  7. "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=Excel 8.0;Data Source=" _
  8. & ThisWorkbook.Path & "" & ThisWorkbook.Name
  9. conn.Open
  10. Sheet1.[C9].Select
  11. If conn.State = adStateOpen Then

  13. ' mxg825更改于20110928
  14. ' 1. 生成SQL
  15. SSQL = "SELECT * from [" & Sheet2.Name & "$]"
  16. Dim ran As Range, SQL2 As String
  17. SQL2 = " WHERE "
  18. For Each ran In Range("B9:L9")
  19. If Len(ran) > 0 Then
  20. If IsDate(ran) Then
  21. SQL2 = SQL2 & ran.Offset(-1, 0) & "=#" & ran & "# and " '日期加 [#]
  22. ElseIf IsNumeric(ran) Then
  23. SQL2 = SQL2 & ran.Offset(-1, 0) & "=" & ran & " and " '数字不用加
  24. Else
  25. SQL2 = SQL2 & ran.Offset(-1, 0) & "='" & ran & "' and " '文本加 [']
  26. End If
  27. End If
  28. Next
  29. If Len(SQL2) > 7 Then '是否添加查询条件
  30. SSQL = SSQL & Left(SQL2, Len(SQL2) - 5) '截取掉 后面多余的 [ and ] 5个字符
  31. End If
  32. ' 2. 执行插入
  33. sRan.Offset(2, -1).CopyFromRecordset conn.Execute(SSQL)

  35. conn.Close
  36. If Sheet1.[B10] = "" Then
  37. MsgBox "“" & Sheet2.Name & "”无数据！"
  38. End If
  39. End If
  40. Set conn = Nothing
  41. End Sub
复制代码

回复

使用道具 举报

yangting
 楼主| 发表于 2011-10-1 23:50 | 显示全部楼层
谢谢，各大师。经几位大师修改，各查询可以，但输入、修改又出现错误。提示数据不匹配。
烦死了。
回复

使用道具 举报

byhdch
发表于 2011-10-12 21:48 | 显示全部楼层
学习学习......
回复

使用道具 举报

发表于 2012-8-16 21:57 | 显示全部楼层
不动脑...................
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-5-14 07:08 , Processed in 0.316169 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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