hao
楼主是不是同时传一个MDB文件来
---------------------------------------------
我看着了。原来是代码生成的啊。呵呵
这方面的东西希望能多提供像我这样的初学者,谢谢!这些资料做的不错
数据库文件使用7楼的
发了那么多,居然没有人给个评价
我打开1楼的excel文件怎么出错!找不到工程或库
data上显示错误
Private Sub Workbook_Open()
Sheet2.Select
[E10] = Date - 90
[E11] = Date
End Sub
MDB文件见13楼
很不错的学习机会,谢谢了。
MDB文件见13楼
MDB文件见13楼
很好的学习
点击主控表中的"新建数据库"按纽,就可以建立一个.MDB文件了
zez老师:
谢谢您的指导和付出!全部下载了。这个专题也非常值得学习和研究,在稍后学习中,再向您请教!!
谢谢!!
请教LZ:
如何用代码生成ACCESS中的查询表(查询视图),谢谢!
以后改为发代码,不再传附件,目前及以后所发代码需要的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
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
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
这个对我来说还太难,现在还要学习初级的呢,不过还是非常感谢LZ的无私奉献精神,等学的小有所成的时候再来拜师
多谢!
送楼主鲜花一朵!
[em22]非常感谢楼主的无私奉献!资料都下载了.代码非常详实.一定认真学习.再次感谢!!!!!!!!!!!!!!!
一并收下,谢谢楼主
谢谢 excelhome
谢谢 zez老师
送上鲜花一朵,聊表敬意。
非常感谢楼主之奉献,正好需要,有不明白的再另行请教,祝好~~
查询到此已介绍完
到现在为止,我要介绍的内容已全部介绍完毕.所上传的代码只要简单地修改一下,就可以做出自己所想要的数据库.祝愿大家都能做出更好的成绩.并谢谢大家对我上传的这个贴子的关注
都下来了,还不知有没有用,先对楼主的无私表示由衷的敬意和感谢了再说。
谢谢楼主的传授!
顶!
非常感谢zez 老师,我正在这方面的资料,这是及时雨啊
不过我还是个菜鸟,还要向您多多请教
很好很好
zez 老师你好,我的系统是英文版的,office也是英文版的,所以打开你的这些数据库代码里面每一张表的名称都是乱码,有什么方法可以解决这个问题吗?
很想学学这方面的东西,现在不能用觉得很遗憾,望指教,不胜感激!!
多谢楼主的无私奉献,我一定好好研读。
多谢楼主的无私奉献,我一定好好研读。
十分感谢!
这个好呀,我正需要,谢谢
全部下载,不懂再来请教!
全部收藏!感谢楼主辛勤工作!
非常感谢!
一直有这种想法,即苦于没有这方面的教材!强烈支持楼主!谢谢
早就想找这方面的资料,太谢谢了!
我也想学习这方面的知识,谢谢楼主提供
留名,慢慢学习中~~
谢谢lz.
谢谢楼主
[em45]多谢老师,收藏了了
谢谢!太好了!
原帖由 ilovexiahua 于 2008-10-28 17:02 发表 [url=http://club.excelhome.net/redirect.php?谢谢,楼主的分享。
我是个初学者,我想请教一下,如何写代码将.txt的文件导入到Access数据库呢?因为Excel的文件只能保存6万多条,而我的数据超出了这么多,所以只能用.txt的文件,希望楼主赐教!谢谢了!
原帖由 ilovexiahua 于 2008-11-4 16:05 发表
楼主:
在Excel将超过65536条的外部文本文件直接导入Access中是如何操作的?因为你的方法是先将用excel作为临时存放,然后再导入Access中,如果超过65536条的话就会有数据会被拉掉!还望楼主指教!谢谢!
欢迎光临 ExcelHome技术论坛 (https://club.excelhome.net/) | Powered by Discuz! X3.4 |