ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
楼主: zez

在EXCEL中操作ACCESS库

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-10-13 09:48 | 显示全部楼层

导入部份字段数据

以后改为发代码,不再传附件,目前及以后所发代码需要的MDB文件见27楼,直到另传附件

Public Sub 导入部份字段数据1()
    Dim myData As String, myTable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    myData = ThisWorkbook.Path & "\职工管理.mdb"
    myTable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open myData
    End With
    SQL = "select 姓名,性别,所属部门,职务,职称,年龄,进本单位时间 from " _
        & myTable & " order by 职工编号"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 导入部份字段数据2()
    Dim myData As String, myTable As String, SQL As String
    Dim myDb As DAO.Database
    Dim myRs As DAO.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    myData = ThisWorkbook.Path & "\职工管理.mdb"
    myTable = "职工基本信息"
    Set myDb = OpenDatabase(myData)
    SQL = "select 姓名,性别,所属部门,职务,职称,年龄,进本单位时间 from " _
        & myTable & " order by 职工编号"
    Set myRs = myDb.OpenRecordset(SQL)
    For i = 1 To myRs.Fields.Count
        Cells(1, i) = myRs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, myRs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset myRs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    myRs.Close
    myDb.Close
    Set myRs = Nothing
    Set myDb = Nothing
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-10-13 09:49 | 显示全部楼层

查询方法1

Public Sub 查询全部字段前面若干条记录()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    SQL = "select top 5 * from " & mytable _
        & " where 年龄>40 order by 年龄 DESC"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 查询部份字段前面若干条记录()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    mydata = ThisWorkbook.Path & "\职工管理.mdb"
    mytable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    SQL = "select top 5 姓名,性别,所属部门,职务,职称,年龄,进本单位时间" _
        & " from " & mytable _
        & " where 年龄>40 order by 年龄 DESC"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 查询不重复字段的内容()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    '清除工作表的全部数据
    ActiveSheet.Cells.Clear
    '输入标题
    With Range("A1:C1")
        .Value = Array("部门", "职称类别", "职务类别")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    '指定数据库和数据表
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    '建立与数据库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '查询数据表中不重复的部门名称,并复制数据
    SQL = "select distinct 所属部门 from " & mytable
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    Range("A2").CopyFromRecordset rs
    '查询数据表中不重复的职称类别名称,并复制数据
    SQL = "select distinct 职称 from " & mytable
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    Range("B2").CopyFromRecordset rs
    '查询数据表中不重复的职务名称,并复制数据
    SQL = "select distinct 职务 from " & mytable
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    Range("C2").CopyFromRecordset rs
    '设置工作表格式
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    '关闭记录集及数据库连接,并释放变量
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub
Public Sub 利用Like运算符进行模糊查询()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    '清除工作表的全部数据
    ActiveSheet.Cells.Clear
    '指定数据库和数据表
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    '建立与数据库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '查询数据表
    SQL = "select * from " & mytable & " where 姓名 like '李%'"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    '复制字段名
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    '设置字段名字体为加粗并居中对齐
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    '复制全部数据
    Range("A2").CopyFromRecordset rs
    '设置工作表格式
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    '关闭记录集及数据库连接,并释放变量
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub
Public Sub 查询某一区间的记录()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    '清除工作表的全部数据
    ActiveSheet.Cells.Clear
    '指定数据库和数据表
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    '建立与数据库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '查询数据表
    SQL = "select * from " & mytable _
        & " where 年龄 between 30 and 40 order by 年龄 DESC"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    '复制字段名
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    '设置字段名字体为加粗并居中对齐
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    '复制全部数据
    Range("A2").CopyFromRecordset rs
    '设置工作表格式
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    '关闭记录集及数据库连接,并释放变量
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub
Public Sub 查询存在于某集合里面的记录()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    mydata = ThisWorkbook.Path & "\职工管理.mdb"
    mytable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    SQL = "select * from " & mytable _
        & " where 年龄> 40 and 职称 in('工程师','经济师') order by 年龄 DESC"
    Set rs = cnn.Execute(SQL)
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub


TA的精华主题

TA的得分主题

 楼主| 发表于 2008-10-13 10:00 | 显示全部楼层

查询2

Public Sub 将查询结果进行排序()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    mydata = ThisWorkbook.Path & "\职工管理.mdb"
    mytable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    SQL = "select * from " & mytable _
        & " order by 年龄 DESC, 工龄 DESC, 本单位工龄 DESC"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 复杂条件查询()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    ActiveSheet.Cells.Clear
    mydata = ThisWorkbook.Path & "\职工管理.mdb"
    mytable = "职工基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    SQL = "select * from " & mytable _
        & " where 职称='工程师' and (年龄 between 30 and 40)" _
        & " and 文化程度 in('硕士','博士') order by 职工编号"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    '复制字段名
    For i = 1 To rs.Fields.Count
        Cells(1, i) = rs.Fields(i - 1).Name
    Next i
    With Range(Cells(1, 1), Cells(1, rs.Fields.Count))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    Range("A2").CopyFromRecordset rs
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 查询最大值和最小值()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer
    '清除工作表的全部数据
    ActiveSheet.Cells.Clear
    '指定数据库和数据表
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    '建立与数据库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '查询数据表
    SQL = "select max(年龄) as Age1,min(年龄) as Age2," _
        & "max(工龄) as Workage1,min(工龄) as Workage2," _
        & "max(本单位工龄) as Dage1,min(本单位工龄) as Dage2 " _
        & "from " & mytable
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    '也可以使用下面的语句
'    Set rs = cnn.Execute(SQL)
    '复制数据
    Range("A1:F1") = Array("最大年龄", "最小年龄", "最大工龄", _
        "最小工龄", "最大本单位工龄", "最小本单位工龄")
    Range("A2:F2") = Array(rs!Age1, rs!Age2, _
        rs!Workage1, rs!Workage2, rs!Dage1, rs!Dage2)
    '设置工作表格式
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    '关闭记录集及数据库连接,并释放变量
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Public Sub 查询合计值和平均值()
    Dim mydata As String, mytable As String, SQL As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Integer, DeptTotal As Integer
    '清除工作表的全部数据
    ActiveSheet.Cells.Clear
    '指定数据库和数据表
    mydata = ThisWorkbook.Path & "\职工管理.mdb"    '指定数据库
    mytable = "职工基本信息"      '指定数据表
    '建立与数据库的连接
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    '查询不重复的部门名称
    SQL = "select distinct 所属部门 from " & mytable
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    DeptTotal = rs.RecordCount
    ReDim myDept(1 To DeptTotal)
    For i = 1 To DeptTotal
        myDept(i) = rs.Fields("所属部门")
        rs.MoveNext
    Next i
    '开始查询计算各部门的平均年龄
    Range("A1:B1") = Array("部门", "平均年龄")
    For i = 1 To DeptTotal
        Cells(i + 1, 1) = myDept(i)
        SQL = "select avg(年龄) as myAvg from " & mytable _
            & " where 所属部门='" & myDept(i) & "'"
        Set rs = cnn.Execute(SQL)
        Cells(i + 1, 2) = Round(rs!myAvg, 2)
    Next i
    '开始查询计算本单位全部职工的平均年龄
    Range("C1:E1") = Array("本单位全部职工", "本单位男职工", "本单位女职工")
    SQL = "select avg(年龄) as myAvg from " & mytable
    Set rs = cnn.Execute(SQL)
    Cells(2, 3) = Round(rs!myAvg, 2)
    '开始查询计算本单位男职工的平均年龄
    SQL = "select avg(年龄) as myAvg from " & mytable & " where 性别='男'"
    Set rs = cnn.Execute(SQL)
    Cells(2, 4) = Round(rs!myAvg, 2)
    '开始查询计算本单位女职工的平均年龄
    SQL = "select avg(年龄) as myAvg from " & mytable & " where 性别='女'"
    Set rs = cnn.Execute(SQL)
    Cells(2, 5) = Round(rs!myAvg, 2)
    '设置工作表格式
    ActiveSheet.Cells.Font.Size = 10
    ActiveSheet.Columns.AutoFit
    '关闭记录集及数据库连接,并释放变量
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

评分

参与人数 1鲜花 +1 收起 理由
wlq12345 + 1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2008-10-13 13:40 | 显示全部楼层

这个对我来说还太难,现在还要学习初级的呢,不过还是非常感谢LZ的无私奉献精神,等学的小有所成的时候再来拜师

TA的精华主题

TA的得分主题

发表于 2008-10-13 21:16 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2008-10-14 07:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2008-10-14 08:40 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2008-10-14 08:58 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-10-14 09:45 | 显示全部楼层

查询3

qQgJn7NR.rar (1.82 KB, 下载次数: 3049)

TA的精华主题

TA的得分主题

 楼主| 发表于 2008-10-14 09:51 | 显示全部楼层

窗体控件

a26LE63z.rar (22.41 KB, 下载次数: 3461)

DiZor1FT.rar

13.37 KB, 下载次数: 3161

在EXCEL中操作ACCESS库

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-12-13 05:53 , Processed in 0.441251 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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