EXCEL利用VBA進(jìn)行數(shù)據(jù)庫操作

1、Public Sub 技巧12_001()創(chuàng)建數(shù)據(jù)庫文件mdb 先引用Microsoft dao 3.6 object library Dim myDatabase As DAO.Database 定義數(shù)據(jù)庫變量 Dim myDataTable As DAO.TableDef 定義數(shù)據(jù)表變量 Dim myDatabaseName As String 定義數(shù)據(jù)庫名稱 Dim myDataTableName As String 定義數(shù)據(jù)表名稱 設(shè)置要?jiǎng)?chuàng)建的數(shù)據(jù)庫名稱（包括完整路徑） myDatabaseName = ThisWorkbook.Path & 客戶管理.mdb 設(shè)置要?jiǎng)?chuàng)建的數(shù)據(jù)

2、表名稱 myDataTableName = 客戶信息 刪除已經(jīng)存在的數(shù)據(jù)庫文件 On Error Resume Next Kill myDatabaseName On Error GoTo 0 創(chuàng)建數(shù)據(jù)庫文件 Set myDatabase = CreateDatabase(myDatabaseName, dbLangGeneral) 創(chuàng)建數(shù)據(jù)表 Set myDataTable = myDatabase.CreateTableDef(myDataTableName) 為數(shù)據(jù)表添加字段 With myDataTable .Fields.Append .CreateField(客戶編號(hào), dbTex

3、t, 10) .Fields.Append .CreateField(客戶名稱, dbText, 30) .Fields.Append .CreateField(聯(lián)系地址, dbText, 50) .Fields.Append .CreateField(聯(lián)系電話, dbText, 20) .Fields.Append .CreateField(聯(lián)系人, dbText, 10) .Fields.Append .CreateField(Email, dbText, 50) End With Append方法將這些字段添加到TableDef對(duì)象的Fields集合里 myDatabase.TableD

4、efs.Append myDataTable Set myDatabase = Nothing 釋放變量 彈出信息 MsgBox 創(chuàng)建數(shù)據(jù)庫成功！ & vbCrLf _ & 數(shù)據(jù)庫文件名為： & myDatabaseName & vbCrLf _ & 數(shù)據(jù)表名稱為： & myDataTableName & vbCrLf _ & 保存位置：當(dāng)前工作簿所在的文件夾。, _ vbOKOnly + vbInformation, 創(chuàng)建數(shù)據(jù)庫End SubPublic Sub 技巧12_002()創(chuàng)建數(shù)據(jù)庫 先引用Microsoft acti

5、vex data objects 2.8 library 先引用microsoft ado ext.2.8 for dll and security Dim myCat As New ADOX.Catalog Dim cnn As ADODB.Connection Dim myCmd As ADODB.Command Dim myDatabaseName As String Dim myDataTableName As String 設(shè)置包括完整路徑的數(shù)據(jù)庫文件名 myDatabaseName = ThisWorkbook.Path & 客戶管理.mdb myDataTableName

6、 = 客戶信息 如果有同名的數(shù)據(jù)庫文件，就刪除它 On Error Resume Next Kill myDatabaseName On Error GoTo 0 創(chuàng)建新數(shù)據(jù)庫文件 myCat.Create Provider=Microsoft.Jet.OLEDB.4.0;Data Source= & myDatabaseName Set cnn = myCat.ActiveConnection 創(chuàng)建數(shù)據(jù)表“客戶信息” Set myCmd = New ADODB.Command Set myCmd.ActiveConnection = cnn myCmd.CommandText = C

7、REATE TABLE & myDataTableName & _ (客戶編號(hào) text(10),客戶名稱 text(30),聯(lián)系地址 text(50), _ & 聯(lián)系電話 text(20),聯(lián)系人 text(10),Email text(50) myCmd.Execute , , adCmdText cnn.Close Set cnn = Nothing Set myCat = Nothing Set myCmd = Nothing 彈出信息 MsgBox 創(chuàng)建數(shù)據(jù)庫成功！ & vbCrLf _ & 數(shù)據(jù)庫文件名為： & myDatabaseN

8、ame & vbCrLf _ & 數(shù)據(jù)表名稱為： & myDataTableName & vbCrLf _ & 保存位置：當(dāng)前工作簿所在的文件夾。, _ vbOKOnly + vbInformation, 創(chuàng)建數(shù)據(jù)庫End Sub鏈接到數(shù)據(jù)庫Public Sub 技巧12_003()判斷數(shù)據(jù)表是否存在 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String Dim cnn As ADODB.Connection Dim rs As ADOD

9、B.Recordset mydata = ThisWorkbook.Path & 客戶管理.mdb 指定數(shù)據(jù)庫文件 mytable = 客戶信息 指定要查詢的數(shù)據(jù)表名稱 建立與數(shù)據(jù)庫的廉潔 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 開始查詢是否存在該數(shù)據(jù)表 Set rs = cnn.OpenSchema(adSchemaTables) Do Until rs.EOF If LCase(rs!table_name) = LCase(my

10、table) Then MsgBox 數(shù)據(jù)表 存在！ GoTo hhh End If rs.MoveNext Loop MsgBox 數(shù)據(jù)表 & mytable & 不存在！hhh: rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_004()與數(shù)據(jù)庫鏈接，并取得表頭 先引用microsoft ado ext.2.8 for dll and security Dim mydata As String Dim mycat As New ADOX.Catalog mydata =

11、ThisWorkbook.Path & 客戶管理.mdb 指定數(shù)據(jù)庫文件 建立與數(shù)據(jù)庫的連接 mycat.ActiveConnection = Provider=microsoft.jet.oledb.4.0; _ & Data Source= & mydata Msg = k = 1 For i = 0 To mycat.Tables.Count - 1 If Left(mycat.Tables.Item(i).Name, 4) MSys Then ActiveSheet.Cells(k, 1) = mycat.Tables.Item(i).Name k = k +

12、1 End If Next i Set mycat.ActiveConnection = NothingEnd SubPublic Sub 技巧12_005()判斷數(shù)據(jù)表中是否存在字段 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String, mycolumn As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset mydata = ThisWorkbook.Path & 客戶管理.mdb 指定數(shù)據(jù)庫

13、 mytable = 客戶資料 指定數(shù)據(jù)表 mycolumn = 客戶名稱 指定字段名稱 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 開始檢查該字段是否存在 Set rs = cnn.OpenSchema(adSchemaColumns) Do Until rs.EOF If LCase(rs!column_name) = LCase(mycolumn) Then MsgBox 在數(shù)據(jù)表 & mytable &

14、; 中存在字段！ GoTo hhh End If rs.MoveNext Loop MsgBox 在數(shù)據(jù)表 & mytable & 中不存在字段 & mycolumn & ！hhh: rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_006()判斷數(shù)據(jù)庫中表頭字段類型和大小 先引用Microsoft activex data objects 2.8 library 先引用microsoft ado ext.2.8 for dll and security Dim

15、 mydata As String, mytable As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim myField As ADODB.Field Dim FieldType As String, FieldLong As Integer mydata = ThisWorkbook.Path & 客戶管理.mdb 指定數(shù)據(jù)庫 mytable = 客戶信息 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = micro

16、soft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 Set rs = New ADODB.Recordset rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic 查詢字段數(shù)據(jù)類型和大小 ActiveSheet.Cells.Clear ActiveSheet.Range(A1:C1) = Array(字段名稱, 字段類型, 字段大小) k = 2 For Each myField In rs.Fields 將字段名稱、類型和大小輸出到工作表 ActiveSheet.Range(A & k) =

17、 myField.Name ActiveSheet.Range(B & k) = myField.Type ActiveSheet.Range(C & k) = myField.DefinedSize k = k + 1 Next rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_007()判斷數(shù)據(jù)庫中表頭字段類型和大小 先引用Microsoft activex data objects 2.8 library 先引用microsoft ado ext.2.8 for dll

18、and security Dim mydata As String, mytable As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim myField As ADODB.Field Dim FieldType As String, FieldLong As Integer mydata = ThisWorkbook.Path & 客戶管理.mdb 指定數(shù)據(jù)庫 mytable = 客戶信息 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .

19、Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 Set rs = New ADODB.Recordset rs.Open mytable, cnn, adOpenKeyset, adLockOptimistic 查詢字段數(shù)據(jù)類型和大小 ActiveSheet.Cells.Clear ActiveSheet.Range(A1:C1) = Array(字段名稱, 字段類型, 字段大小) k = 2 For Each myField In rs.Fields 將字段名稱、類型和大小輸出到工作表 ActiveSheet.Ra

20、nge(A & k) = myField.Name ActiveSheet.Range(B & k) = IntegerToVBAConstant(myField.Type) ActiveSheet.Range(C & k) = myField.DefinedSize k = k + 1 Next rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubVBA常量名稱與數(shù)字的轉(zhuǎn)換函數(shù)Function VBAConstantToInteger(myVBAConstant As String) As Integ

21、er Dim myInteger As Integer Select Case myVBAConstant Case adBigInt: myInteger = 20 Case adBinary: myInteger = 128 Case adBoolean: myInteger = 11 Case adBSTR: myInteger = 8 Case adChapter: myInteger = 136 Case adChar: myInteger = 129 Case adCurrency: myInteger = 6 Case adDate: myInteger = 7 Case adD

22、BDate: myInteger = 133 Case adDBTime: myInteger = 134 Case adDBTimeStamp: myInteger = 135 Case adDecimal: myInteger = 14 Case adDouble: myInteger = 5 Case adEmpty: myInteger = 0 Case adError: myInteger = 10 Case adFileTime: myInteger = 64 Case adGUID: myInteger = 72 Case adIDispatch: myInteger = 9 C

23、ase adInteger: myInteger = 3 Case adIUnknown: myInteger = 13 Case adLongVarBinary: myInteger = 205 Case adLongVarChar: myInteger = 201 Case adLongVarWChar: myInteger = 203 Case adNumeric: myInteger = 131 Case adPropVariant: myInteger = 138 Case adSingle: myInteger = 4 Case adSmallInt: myInteger = 2

24、Case adTinyInt: myInteger = 16 Case adUnsignedBigInt: myInteger = 21 Case adUnsignedInt: myInteger = 19 Case adUnsignedSmallInt: myInteger = 18 Case adUnsignedTinyInt: myInteger = 17 Case adUserDefined: myInteger = 132 Case adVarBinary: myInteger = 204 Case adVarChar: myInteger = 200 Case adVariant:

25、 myInteger = 12 Case adVarNumeric: myInteger = 139 Case adVarWChar: myInteger = 202 Case adWChar: myInteger = 130 Case Else: myInteger = -1 End Select VBAConstantToInteger = myIntegerEnd Function與數(shù)字與VBA常量名稱轉(zhuǎn)換函數(shù)Function IntegerToVBAConstant(myInteger As Integer) As String Dim myVBAConstant As String

26、Select Case myInteger Case 20: myVBAConstant = adBigInt Case 128: myVBAConstant = adBinary Case 11: myVBAConstant = adBoolean Case 8: myVBAConstant = adBSTR Case 136: myVBAConstant = adChapter Case 129: myVBAConstant = adChar Case 6: myVBAConstant = adCurrency Case 7: myVBAConstant = adDate Case 133

27、: myVBAConstant = adDBDate Case 134: myVBAConstant = adDBTime Case 135: myVBAConstant = adDBTimeStamp Case 14: myVBAConstant = adDecimal Case 5: myVBAConstant = adDouble Case 0: myVBAConstant = adEmpty Case 10: myVBAConstant = adError Case 64: myVBAConstant = adFileTime Case 72: myVBAConstant = adGU

28、ID Case 9: myVBAConstant = adIDispatch Case 3: myVBAConstant = adInteger Case 13: myVBAConstant = adIUnknown Case 205: myVBAConstant = adLongVarBinary Case 201: myVBAConstant = adLongVarChar Case 203: myVBAConstant = adLongVarWChar Case 131: myVBAConstant = adNumeric Case 138: myVBAConstant = adProp

29、Variant Case 4: myVBAConstant = adSingle Case 2: myVBAConstant = adSmallInt Case 16: myVBAConstant = adTinyInt Case 21: myVBAConstant = adUnsignedBigInt Case 19: myVBAConstant = adUnsignedInt Case 18: myVBAConstant = adUnsignedSmallInt Case 17: myVBAConstant = adUnsignedTinyInt Case 132: myVBAConsta

30、nt = adUserDefined Case 204: myVBAConstant = adVarBinary Case 200: myVBAConstant = adVarChar Case 12: myVBAConstant = adVariant Case 139: myVBAConstant = adVarNumeric Case 202: myVBAConstant = adVarWChar Case 130: myVBAConstant = adWChar Case Else: myVBAConstant = Error End Select IntegerToVBAConsta

31、nt = myVBAConstantEnd FunctionPublic Sub 技巧12_008()從數(shù)據(jù)庫總復(fù)制數(shù)據(jù) 先引用Microsoft activex data objects 2.8 library 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 & 成績(jī)管理.mdb 指

32、定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select * from & mytable Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs.Fields.Count Cells(1, i) =

33、 rs.Fields(i - 1).Name Next i With Range(Cells(1, 1), Cells(1, rs.Fields.Count) .Font.Bold = True .HorizontalAlignment = xlCenter End With 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs 設(shè)置工作表格式 ActiveSheet.Columns(rs.Fields.Count).NumberFormat = yyyy-mm-dd ActiveSheet.Columns.AutoFit rs.Close cnn.Close Set r

34、s = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_009()取得固定列的數(shù)據(jù) 先引用Microsoft activex data objects 2.8 library 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 & 成績(jī)管理.

35、mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select 姓名,班級(jí),數(shù)學(xué),語文 from & mytable & order by 學(xué)號(hào) Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1

36、 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 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs 設(shè)置工作表格式 ActiveSheet.Columns.AutoFit rs.Close cnn.Close Set rs = Nothing Set cnn = NothingE

37、nd SubPublic Sub 技巧12_010()獲得某項(xiàng)的所有項(xiàng)名 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String, SQL As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set c

38、nn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select distinct 班級(jí) from & mytable Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制全部數(shù)據(jù) Range(A1).CopyFromRecordset rs 設(shè)置工作表格式 rs.Close cnn.Close Set rs = Nothi

39、ng Set cnn = NothingEnd SubPublic Sub 技巧12_011()數(shù)學(xué)成績(jī)大于等于90 先引用Microsoft activex data objects 2.8 library 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 & 成績(jī)管理.mdb 指定數(shù)

40、據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select top 10 * from & mytable & where 數(shù)學(xué)=90 order by 數(shù)學(xué) desc Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 Fo

41、r i = 1 To rs.Fields.Count Cells(1, i) = rs.Fields(i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_012()姓郭的 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String, SQL As String Dim cn

42、n As ADODB.Connection Dim rs As ADODB.Recordset Dim i As Integer ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select * from & my

43、table & where 姓名 like 郭% Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs.Fields.Count Cells(1, i) = rs.Fields(i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_0

44、13()總分排名 先引用Microsoft activex data objects 2.8 library 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 & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New AD

45、ODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select * from & mytable _ & order by 總分 DESC,數(shù)學(xué) DESC,語文 DESC Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs.Fields.Count Cells(1, i) = rs.Fields(

46、i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_014()一班數(shù)學(xué)在80-90之間的 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String, SQL As String Dim cnn As ADODB.Connection Dim rs As ADODB.Rec

47、ordset Dim i As Integer ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select * from & mytable _ & where 班級(jí)=初一1班 and 數(shù)學(xué) betwee

48、n 80 and 90 Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs.Fields.Count Cells(1, i) = rs.Fields(i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_015()多項(xiàng)選擇 先引用Micro

49、soft activex data objects 2.8 library 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 & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection Wi

50、th cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select * from & mytable _ & where (班級(jí)=初一1班 and 性別=男) and (數(shù)學(xué)=95 or 語文=95) _ & and year(日期)=2006 and month(日期)=7 Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs

51、.Fields.Count Cells(1, i) = rs.Fields(i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_016()數(shù)學(xué)最高分和最低分 先引用Microsoft activex data objects 2.8 library Dim mydata As String, mytable As String, SQL As String Dim cnn As AD

52、ODB.Connection Dim rs As ADODB.Recordset Dim i As Integer ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select max(數(shù)學(xué)) as math1,min(數(shù)

53、學(xué)) as math2 from & mytable Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制數(shù)據(jù) Range(A1:B1) = Array(數(shù)學(xué)最高分, 數(shù)學(xué)最低分) Range(A2:B2) = Array(rs!math1, rs!math2) rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_017()各班級(jí)平均分 Dim mydata As String,

54、mytable As String, SQL As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Dim i As Integer, ClassTotal As Integer Dim myArray As Variant ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provid

55、er = microsoft.jet.oledb.4.0 .Open mydata End With 查詢不重復(fù)的班級(jí)名稱 SQL = select distinct 班級(jí) from & mytable Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic ClassTotal = rs.RecordCount ReDim myclass(1 To ClassTotal) For i = 1 To ClassTotal myclass(i) = rs.Fields(班級(jí)) rs.Mov

56、eNext Next i myArray = Array(數(shù)學(xué), 語文, 物理, 化學(xué), 英語, 體育, 總分) Range(A1) = 班級(jí) Range(B1:H1) = myArray 開始查詢各科的平均分 For i = 1 To ClassTotal Cells(i + 1, 1) = myclass(i) For j = 0 To UBound(myArray) SQL = select avg( & myArray(j) & ) as myAvg from & mytable _ & where 班級(jí)= & myclass(i) &

57、Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic Cells(i + 1, j + 2) = Round(rs!myAvg, 2) Next j Next i rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_018()初一2班學(xué)生中數(shù)學(xué)成績(jī)大于平均分的 Dim mydata As String, mytable As String, SQL As String Dim cnn As AD

58、ODB.Connection Dim rs As ADODB.Recordset Dim i As Integer ActiveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With 查詢數(shù)據(jù)表 SQL = select *, _ & (select avg

59、(數(shù)學(xué)) as mathAvg from & mytable & where 班級(jí)=初一2班) _ & from & mytable & _ where 班級(jí)=初一2班 _ & and 數(shù)學(xué)=(select avg(數(shù)學(xué)) from & mytable & where 班級(jí)=初一2班) Set rs = New ADODB.Recordset rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic 復(fù)制字段名 For i = 1 To rs.Fields.Count Cells(1, i)

60、 = rs.Fields(i - 1).Name Next i 復(fù)制全部數(shù)據(jù) Range(A2).CopyFromRecordset rs Range(A1) = 班級(jí)數(shù)學(xué)平均分 rs.Close cnn.Close Set rs = Nothing Set cnn = NothingEnd SubPublic Sub 技巧12_019()各班級(jí)學(xué)生的各課程和總分的平均分 Dim mydata As String, mytable As String, SQL As String Dim cnn As ADODB.Connection Dim rs As ADODB.Recordset Act

61、iveSheet.Cells.Clear mydata = ThisWorkbook.Path & 成績(jī)管理.mdb 指定數(shù)據(jù)庫 mytable = 考試成績(jī) 指定數(shù)據(jù)表 建立與數(shù)據(jù)庫的連接 Set cnn = New ADODB.Connection With cnn .Provider = microsoft.jet.oledb.4.0 .Open mydata End With SQL = select 班級(jí),avg(數(shù)學(xué)) as 數(shù)學(xué)平均,avg(語文) as 語文平均, _ & avg(物理) as 物理平均,avg(化學(xué)) as 化學(xué)平均,avg(英語) as 英語平均, _ & avg(體育) as 體育平均,avg(總分) as 總分平均 _ & from & mytable & group