ADO | 完美Excel

本类文章的标签为 ‘ADO’

使用ADO筛选Excel工作簿中的数据

2009年06月30日, 1:58 下午

(目前还没有人投票)

Loading ...

这是在datawright中看到的一个示例，辑录于此，与大家分享。
可以先下载示例研究：

有许多种方法筛选Excel中的数据，最常用的方法是使用内置的自动筛选或高级筛选功能。虽然这两种内置功能非常强大，但其局限是需要将筛选的结果放置在与原数据相同的工作表内。如果需要将数据提取到不同的工作表，则需要不同的方式。
使用ADO，您可以创建查询，从而将筛选的数据放置到您想放置的位置。
示例工作簿中有两个工作表：DB_Data和Data2。其中，DB_Data里为包含约160个姓名的列表，Data2中有一个数据有效性下拉列表（即黄色底纹的单元格），可从中选择一个字母。一旦从中选择一个字母，以此字母为开头的姓就会复制到工作表Data2中。
主要的代码清单如下：

Sub ADO_Self_Excel()
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Dim sSQL As String
  Dim sPath As String
  Dim MyConn
  Dim sFilter As String
 
  sPath = ActiveWorkbook.FullName
 
  '定义筛选和提取姓名的SQL语句.
  '在ADO中使用%作为通配符而不是*

  sFilter = UCase(Sheets("Data2").Range("H1").Value) & "%"
 
  '在SQL中可以像表一样看待工作表名称
  '为此,将后缀$放置在名称的末尾并加上方括号
  
  sSQL = "SELECT * FROM [DB_Data$]" 'DB_Data是源工作表
  sSQL = sSQL & " WHERE LastName Like '" & sFilter & "'"
 
  '建立对相同文件的连接
  '当连接到Excel而不是数据库时,需要定义扩展的属性为Excel 8.0 (第1个使用ADO的Excel版本)
  
  MyConn = sPath
 
  Set cnn = New ADODB.Connection
  With cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Extended Properties").Value = "Excel 8.0"
    .Open MyConn
  End With
 
  '定义基于SQL语句的记录集

  Set rst = New ADODB.Recordset
  rst.CursorLocation = adUseServer
  rst.Open Source:=sSQL, _
    ActiveConnection:=cnn, _
    CursorType:=adOpenForwardOnly, _
    LockType:=adLockOptimistic, _
    Options:=adCmdText
 
  Application.ScreenUpdating = False
 
  '删除目标工作表中已存在的数据
  '然后以单元格A2开始填充最新筛选的结果
  '完成后,清除引用以避免内存泄漏

  With Sheets("Data2") 'Data2是目标工作表
    .Range("A1").CurrentRegion.Offset(1, 0).Clear
    .Range("A2").CopyFromRecordset rst
  End With
  rst.Close
  cnn.Close
 
  Application.ScreenUpdating = True
 
End Sub

下面的代码使用相应工作表Data2中的Worksheet_Change事件。这样，当单元格H1发生变化时，ADO_Self_Excel将使用H1中的内容创建筛选。如果H1为空，那么返回所有的记录。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Range("H1"), Target) Is Nothing Then Exit Sub
    Call ADO_Self_Excel
End Sub

标签：ADO, 技巧, 数据筛选
分类目录： VBA | 评论 | 808 次阅读

使用ADO在Excel和Access之间传递数据

2009年06月8日, 9:22 下午

(4 人投票, 平均: 3.25 out of 5)

Loading ...

Excel擅长于分析数据，而Access则擅长于储存和整理数量较大且复杂的数据集，因此，将这两个应用软件协同使用，充分利用各自的优势，可以创建强大的数据处理工具。
使用VBA，能够在两个应用软件之间传递一条或多条记录，也能够通过Excel更新Access数据库。有两种主要的对象模型用于与Access相交互：DAO适用于处理Jet数据库引擎，而更新且更通用的ADO则适用于为企业级的数据库传递数据，例如SQL Server和Oracle。
在开始下面的内容之前，最好先下载示例文件，以便对照学习。
示例文件下载：人口预测.xls

示例文件说明
在示例文件中，“人口预测”工作表中1950年和2000年列是每个国家的实际人口，其它列是预测的人口，当单击“创建数据库”按钮时，会在与Excel文件相同的文件夹下创建一个名为“数据库测试.mdb”的Access数据库。该数据库包含一个带有7个字段的名为tblPopulation的表。当单击“装载到Access”按钮时，将装载工作表中所有记录到Access数据库的tblPopulation表。
“新字段”工作表中具有与“人口预测”工作表相同的人口数据，但增加了一个“区域”列。单击“插入字段”按钮，将添加“区域”字段到Access数据库的tblPopulation表；单击“更新字段数据”按钮，将更新Access表中的数据，即使用工作表列C中相匹配的数据更新数据库中新创建的区域字段的数据。单击“删除字段”按钮，将删除所创建的“区域”字段。
“下载表”工作表中，单击“下载表”按钮将使用数据库表tblPopulation中的数据填充该工作表；单击“更新当前记录”，如果您修改了当前行中的某个数据，那么修改将被写入到Access表中相应的记录。
“区域”工作表中，在单元格K1中具有数据有效性列表。从列表中选择一个值将触发事件代码，然后调用相应的代码模块下载该区域所有国家的数据到该工作表中。
“前20条”工作表中，单击“下载前20条记录”按钮，将数据表中前20条记录载入工作表中。
使用ADOX创建Access数据库和表
步骤1：设置合适的库引用
在VBE中，单击“工具——引用”，选择“Microsoft ActiveX Data Objects 2.X Library”和“Microsoft ADO Ext. 2.x for DDL And Security”。
步骤2：输入代码
在模块的声明部分，声明常量：

Const TARGET_DB = "数据库测试.mdb"

然后，输入下面的代码，以创建数据库。

Sub CreateDB_And_Table()
 
    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sDB_Path As String
 
    sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    '如果该数据库已存在则删除
    On Error Resume Next
    Kill sDB_Path
    On Error GoTo 0
 
    '创建新数据库
    Set cat = New ADOX.Catalog
    cat.Create _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sDB_Path & ";"
 
    '创建表
    Set tbl = New ADOX.Table
    tbl.Name = "tblPopulation"
    tbl.Columns.Append "PopID", adInteger
    tbl.Columns.Append "国家", adVarWChar, 60
    tbl.Columns.Append "1950年", adDouble
    tbl.Columns.Append "2000年", adDouble
    tbl.Columns.Append "2015年", adDouble
    tbl.Columns.Append "2025年", adDouble
    tbl.Columns.Append "2050年", adDouble
    cat.Tables.Append tbl
 
    Set cat = Nothing
 
End Sub

步骤3：将CreateDB_And_Table过程关联到“创建数据库”按钮。
代码说明：上述代码首先创建一个新的Catalog，即使用ADOX引用数据库，然后创建一个名为tblPopulation的表，接着为该表添加字段，最后将该表添加到数据库中的Tables集合。
ADOX是ADO的扩展，可用来创建和修改数据库结构（表和字段），专门用来处理Jet数据库引擎。因此，使用ADOX来创建表和字段，并且很容易定义数据类型和索引值。
将工作表中的内容载入数据库表
要将工作表中的内容载入数据为表，需要完成下列步骤：
1、创建对数据库的连接。
2、定义基于表的记录集。
3、遍历列和行，一次装载一个字段数据到每条记录中。因此，对于每行，需要完成：
（1）rst.AddNew（创建一条新记录）
（2）遍历列，将值赋给记录集中的每个字段。本例中，工作表的列标题与数据库表的字段名完全相同，因此，载入数据时可以遍历标题以获取字段列表。
（3）rst.Update（保存记录）
4、最后，通过关闭Recordset和Connection对象然后将其设置为Nothing来完成清理，以避免内存泄漏。
代码如下：

Sub PushTableToAccess()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Long, j As Long
    Dim Rw As Long
 
    '激活所需要的工作表,获取已使用的行数
    Sheets("人口预测").Activate
    Rw = Range("A65536").End(xlUp).Row
 
    '创建对数据库的连接
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    '创建记录集
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="tblPopulation", ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable
 
    '将Excel中所有的记录载入Access.
    For i = 2 To Rw
        rst.AddNew
        For j = 1 To 7
            rst(Cells(1, j).Value) = Cells(i, j).Value
        Next j
        rst.Update
    Next i
 
    ' 关闭连接并清理内存
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

在表中创建新字段并使用新数据更新现有的记录
下面，在现有的表中创建新字段，然后将数据载入到该字段而不影响其它字段。
1、添加新字段
（1）使用ADOX添加字段
按照下面的步骤使用ADOX创建新字段：
1）创建新的ADO连接
2）创建ADOX Catalog（数据库），使该数据库使用刚创建的ADO连接
3）设置对希望修改的表的引用
4）通过追加到该表的Columns集合，添加列到表中。在创建每个字段时，需要字义数据类型。
5）清理引用。
代码如下：

Sub AddNewField_ADOX()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim cat As ADOX.Catalog
    Dim col As ADOX.Column
    Dim tbl As ADOX.Table
    Dim sDB_Path As String
 
    MyConn = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    '连接到数据库并使用该连接创建新的ADOX Catalog
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = cnn
 
    '添加新字段
    Set tbl = cat.Tables("tblPopulation")
    tbl.Columns.Append "区域", adVarWChar, 60
 
    '清理引用
    Set cat = Nothing
    Set col = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub

（2）使用SQL添加字段
还有一种方法是使用SQL修改数据库和表结构，步骤如下：
1）创建新的ADO连接
2）创建Command对象，使其使用刚创建的ADO连接
3）执行添加新字段的SQL语句，在SQL语句中定义了字段类型和大小
4）清理引用
代码如下：

Sub AddNewField_SQL()
 
    Dim cnn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim MyConn
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    '打开连接
    Set cnn = New ADODB.Connection
    With cnn
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Open MyConn
    End With
 
    '创建新的Command对象,并设置其Connection属性
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cnn
    '创建字段
    cmd.CommandText = "ALTER TABLE tblPopulation ADD Column 区域 Char(30)"
    cmd.Execute
 
    '清理引用
    Set cmd = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub

2、更新字段数据
要为多个记录更新字段的内容，需要遍历工作表中的行，一次修改一条记录，必须使用唯一的ID作为关键字段。步骤如下：
1）定位到正确的工作表，并确定需要载入多少行
2）创建ADO连接
3）遍历每条记录——定义当前记录中筛选过的记录集、打开记录集、修改记录、更新并关闭记录集
4）关闭连接并清理引用
代码如下：

Sub PopulateOneField()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Long, j As Long
    Dim Rw As Long
    Dim sSQL As String
 
    Sheets("新字段").Activate
    Rw = Range("A65536").End(xlUp).Row
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    '更新表中所有记录里的某字段
    For i = 2 To Rw
        sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & Cells(i, 1).Value
        rst.Open Source:=sSQL, ActiveConnection:=cnn, _
                 CursorType:=adOpenKeyset, LockType:=adLockOptimistic
            rst(Cells(1, 3).Value) = Cells(i, 3).Value
            rst.Update
        rst.Close
    Next i
 
    ' 关闭连接
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

将Access中表的内容下载到Excel
需要完成下列步骤：
（1）创建到数据库的ADO连接
（2）定义基于tblPopulation的记录集
（3）遍历表中的字段名称并将其写入工作表的第1行
（4）使用CopyFromRecordset方法将数据库记录传递到Excel，开始于第2行。CopyFromRecordset方法比一次遍历一条记录更有效，能够一次传递上千条记录。
（5）清理引用
代码如下：

Sub TransferTableFromAccess()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim MyConn
    Dim i As Long
    Dim ShDest As Worksheet
 
    Set ShDest = Sheets("下载表")
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="tblPopulation", ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable
 
    '清除工作表中已存在的数据
    ShDest.Activate
    Range("A1").CurrentRegion.Offset(1, 0).Clear
 
    '创建字段标题
    i = 0
    With Range("A1")
        For Each fld In rst.Fields
            .Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
    End With
 
    '将数据传递到Excel
    Range("A2").CopyFromRecordset rst
 
    ' 关闭连接
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

使用数据有效性列表从Access查询中导入数据
在“区域”工作表模块中放置下列代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Target = Range("K1") Then Call DownloadRegion
    Application.EnableEvents = True
End Sub

过程DownloadRegion的代码如下：

Sub DownloadRegion()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim MyConn
    Dim i As Long
    Dim ShDest As Worksheet
    Dim sSQL As String
 
    Set ShDest = Sheets("区域")
 
    sSQL = "SELECT * FROM tblPopulation WHERE 区域 ='" & ShDest.Range("K1").Value & "'"
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
             CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, _
             Options:=adCmdText
 
    '清除工作表中已有的数据
    ShDest.Activate
    Range("A1").CurrentRegion.Clear
 
    '创建字段标题
    i = 0
    With Range("A1")
        For Each fld In rst.Fields
            .Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
    End With
 
    '将数据传递到Excel
    Range("A2").CopyFromRecordset rst
 
    ' 关闭连接
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

在Excel中编辑某条记录，并且更新Access表
按照下列步骤：
（1）查找当前行列A中的值，确定要更新的记录的ID。
（2）创建SQL语句，筛选表到要更新的记录。
（3）创建ADO连接，并且基于SQL语句打开记录集。
（4）遍历该行中的每一列，将值写入到该条记录。因为工作表第1行中标题与数据表中的字段名相匹配，所以可以遍历标题以识别要修改的字段。
（5）关闭记录集并清理引用。
代码如下：

Sub AlterOneRecord()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim MyConn
    Dim lngRow As Long
    Dim lngID As Long
    Dim j As Long
    Dim sSQL As String
 
    '确定当前记录的ID并定义SQL语句
    lngRow = ActiveCell.Row
    lngID = Cells(lngRow, 1).Value
 
    sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & lngID
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
             CursorType:=adOpenKeyset, LockType:=adLockOptimistic
 
    '将所有记录从Excel载入到Access.
    For j = 2 To 7
        rst(Cells(1, j).Value) = Cells(lngRow, j).Value
    Next j
    rst.Update
 
    ' 关闭连接
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

删除字段
1、使用ADOX删除字段
按照下列步骤：
（1）创建新的ADO连接。
（2）创建ADOX Catalog（数据库），并使该数据库使用刚创建的ADO连接。
（3）设置对希望修改的表的引用。
（4）通过表的Columns集合从表中删除列。
（5）清理引用。
注：要删除某字段，该字段首先必须已存在于表中。
代码如下：

Sub DeleteAField_ADOX()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim cat As ADOX.Catalog
    Dim col As ADOX.Column
    Dim tbl As ADOX.Table
 
    MyConn = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    '连接数据库
    Set cnn = New ADODB.Connection
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = cnn
 
    '删除列
    Set tbl = cat.Tables("tblPopulation")
    tbl.Columns.Delete "区域"
 
    '清理引用
    Set cat = Nothing
    Set col = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub

2、使用SQL删除字段
还有一种方法是使用SQL来删除字段。按照下列步骤：
（1）创建新的ADO连接。
（2）创建Command对象，使其使用新的ADO连接。
（3）执行SQL语句，使用DROP子句删除字段。
（4）清理引用。
代码如下：

Sub DeleteAField()
 
    Dim cnn As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim MyConn
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    '打开连接
    Set cnn = New ADODB.Connection
    With cnn
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Open MyConn
    End With
 
    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cnn
    '删除字段
    cmd.CommandText = "ALTER TABLE tblPopulation DROP Column 区域"
    cmd.Execute
 
    '清理引用
    Set cmd = Nothing
    cnn.Close
    Set cnn = Nothing
End Sub

从数据库中提取指定数量的记录
从数据库表中获取前20条记录到工作表中的代码如下：

Sub DownloadTop20()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim MyConn
    Dim i As Long
    Dim ShDest As Worksheet
    Dim sSQL As String
 
    Set ShDest = Sheets("前20条")
 
    sSQL = "SELECT * FROM tblPopulation WHERE PopID <= 20"
 
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
 
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
 
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
             CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, _
             Options:=adCmdText
 
    '清除工作表中已有的数据
    ShDest.Activate
    Range("A1").CurrentRegion.Offset(1, 0).Clear
 
    '创建字段标题
    i = 0
    With Range("A1")
        For Each fld In rst.Fields
            .Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
    End With
 
    '将数据传递到Excel
    Range("A2").CopyFromRecordset rst
 
    ' 关闭连接
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
 
End Sub

（本文非常典型，清晰易懂，方便快速学习如何整合Excel与Access。本文整理自datawright.com.au，略有改动，有兴趣的朋友可以参考原文学习）

标签：ADO, Excel与Access, Office整合, 协同应用, 数据库
分类目录： VBA | 2 评论 | 2,154 次阅读

完美Excel

使用ADO筛选Excel工作簿中的数据

相关文章

使用ADO在Excel和Access之间传递数据

相关文章

订阅本站

站点简介

最新评论

热门文章

最新文章

每月日志存档

日志分类

博客圈

站点管理

存档

完美Excel

使用ADO筛选Excel工作簿中的数据

相关文章

使用ADO在Excel和Access之间传递数据

相关文章

订阅本站

站点简介

美味标签

最新评论

热门文章

最新文章

每月日志存档

日志分类

博客圈

站点管理

存档