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

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel 函数公式 › 求助：用SQL，对应查找.rar
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1987|回复: 5

[已解决]求助：用SQL，对应查找.rar

[复制链接]
松儿
发表于 2013-4-13 17:04 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
求助：用SQL，对应查找.rar (11.79 KB, 下载次数: 3)
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
hwc2ycy
发表于 2013-4-13 19:23 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. select A.* ,B.销售精装,B.销售简装,B.销售普通,B.销售收藏 from [购进$]A,[销售$]B  WHERE a.日期=b.日期 AND  a.年级=b.年级 and A.书名=B.书名
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2013-4-13 19:45 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
  1. Sub adosub()
  2.     Dim AdoConn As Object, AdoRst As Object
  3.     Dim StrConn$, strSQL$, DataSource$
  4.     Dim arr(), i As Long


  7.     DataSource = ThisWorkbook.FullName

  9.     Set AdoConn = CreateObject("ADODB.Connection")
  10.     Set AdoRst = CreateObject("ADODB.Recordset")
  11.     strSQL = "select A.*,B.销售精装,B.销售简装,B.销售普通,B.销售收藏 from [购进$] as A,[销售$] as B where a.日期=b.日期 and a.年级=b.年级 and a.书名=b.书名"

  13.     Select Case Application.Version
  14.         Case Is = "14.0":
  15.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  16.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  17.         Case Is = "12.0"
  18.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  19.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  20.         Case Else
  21.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  22.                       "Data Source=" & DataSource & "Extended Properties=""Excel 8.0;HDR=yes;imex=0"";"
  23.     End Select

  25.     On Error GoTo errcheck
  26.     AdoConn.Open StrConn

  28.     If AdoConn.State = 1 Then
  29.         Set AdoRst = AdoConn.Execute(strSQL)
  30.         Worksheets.Add
  31.         Range("a2").CopyFromRecordset AdoRst
  32.         ReDim arr(1 To AdoRst.Fields.Count)
  33.         For i = LBound(arr) To UBound(arr)
  34.             arr(i) = AdoRst.Fields(i - 1).Name
  35.         Next
  36.         Range("a1").Resize(, AdoRst.Fields.Count) = arr
  37.         AdoConn.Close
  38.         MsgBox "合并完成"
  39.     End If
  40.     Set AdoRst = Nothing
  41.     Set AdoConn = Nothing
  42.     Exit Sub
  43.    
  44. errcheck:
  45.     MsgBox Err.Number & vbNewLine & Err.Description
  46.     Exit Sub
  47. End Sub
复制代码
回复

使用道具 举报

hwc2ycy
发表于 2013-4-13 19:47 | 显示全部楼层
  1. Columns("A:A").NumberFormatLocal = "yyyy/m/d"
复制代码
在msgbox 前加这个，否则日期列全是数值显示。
回复

使用道具 举报

hwc2ycy
发表于 2013-4-13 19:52 | 显示全部楼层
  1. Sub adosub()
  2.     Dim AdoConn As Object, AdoRst As Object
  3.     Dim StrConn$, strSQL$, DataSource$
  4.     Dim arr(), i As Byte

  6.     DataSource = ThisWorkbook.FullName
  7.     Set AdoConn = CreateObject("ADODB.Connection")
  8.     Set AdoRst = CreateObject("ADODB.Recordset")

  10.     strSQL = "select A.*,B.销售精装,B.销售简装,B.销售普通,B.销售收藏 from [购进$] as A,[销售$] as B where a.日期=b.日期 and a.年级=b.年级 and a.书名=b.书名"

  12.     Select Case Application.Version
  13.         Case Is = "14.0":
  14.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  15.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  16.         Case Is = "12.0"
  17.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  18.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  19.         Case Else
  20.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  21.                       "Data Source=" & DataSource & "Extended Properties=""Excel 8.0;HDR=yes;imex=0"";"
  22.     End Select

  24.     On Error GoTo Errcheck

  26.     AdoConn.Open StrConn
  27.     Set AdoRst = AdoConn.Execute(strSQL)
  28.     Application.ScreenUpdating = False
  29.     Worksheets.Add

  31.     Range("a2").CopyFromRecordset AdoRst

  33.     With AdoRst.Fields
  34.         ReDim arr(1 To .Count)
  35.         For i = LBound(arr) To UBound(arr)
  36.             arr(i) = .Item(i - 1).Name
  37.         Next
  38.         Range("a1").Resize(, .Count) = arr
  39.     End With

  41.     Columns("A:A").NumberFormatLocal = "yyyy/m/d"
  42.     AdoConn.Close
  43.     Application.ScreenUpdating = True
  44.     MsgBox "合并完成"

  46.     Set AdoRst = Nothing
  47.     Set AdoConn = Nothing
  48.     Exit Sub

  50. Errcheck:
  51.     MsgBox Err.Number & vbNewLine & Err.Description
  52.     Exit Sub
  53. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
松儿 + 3

查看全部评分

回复

使用道具 举报

hwc2ycy
发表于 2013-4-13 19:54 | 显示全部楼层    本楼为最佳答案   
D：K列数字以2位小数显示。
列宽度自动调整。
  1. Sub adosub()
  2.     Dim AdoConn As Object, AdoRst As Object
  3.     Dim StrConn$, strSQL$, DataSource$
  4.     Dim arr(), i As Byte

  6.     DataSource = ThisWorkbook.FullName
  7.     Set AdoConn = CreateObject("ADODB.Connection")
  8.     Set AdoRst = CreateObject("ADODB.Recordset")

  10.     strSQL = "select A.*,B.销售精装,B.销售简装,B.销售普通,B.销售收藏 from [购进$] as A,[销售$] as B where a.日期=b.日期 and a.年级=b.年级 and a.书名=b.书名"

  12.     Select Case Application.Version
  13.         Case Is = "14.0":
  14.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  15.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  16.         Case Is = "12.0"
  17.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
  18.                       DataSource & ";Extended Properties=""Excel 12.0;HDR=yes;imex=0"";"""
  19.         Case Else
  20.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
  21.                       "Data Source=" & DataSource & "Extended Properties=""Excel 8.0;HDR=yes;imex=0"";"
  22.     End Select

  24.     On Error GoTo Errcheck

  26.     AdoConn.Open StrConn
  27.     Set AdoRst = AdoConn.Execute(strSQL)
  28.     Application.ScreenUpdating = False
  29.     Worksheets.Add

  31.     Range("a2").CopyFromRecordset AdoRst

  33.     With AdoRst.Fields
  34.         ReDim arr(1 To .Count)
  35.         For i = LBound(arr) To UBound(arr)
  36.             arr(i) = .Item(i - 1).Name
  37.         Next
  38.         Range("a1").Resize(, .Count) = arr
  39.     End With

  41.     Columns("A:A").NumberFormatLocal = "yyyy/m/d"
  42.     Columns("d:k").NumberFormatLocal = "0.00"
  43.     AdoConn.Close
  44.     ActiveSheet.UsedRange.EntireColumn.AutoFit
  45.     Application.ScreenUpdating = True
  46.     MsgBox "合并完成"

  48.     Set AdoRst = Nothing
  49.     Set AdoConn = Nothing
  50.     Exit Sub

  52. Errcheck:
  53.     MsgBox Err.Number & vbNewLine & Err.Description
  54.     Exit Sub
  55. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
松儿 + 3

查看全部评分

回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-4-25 09:42 , Processed in 0.154081 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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