如何从adodb记录集Excel VBA中的一列中选择不同的值?

问题描述 投票:0回答:2

我有一个从 DB 获得的

ADODB.Recordset rs
。我现在必须重复使用这个记录集两次。

这是我的记录集的示例:

Mike     Client
John     Manager
Karen    Client
Joe      Sub
Brian    Manager

现在我需要获得所有标题,所以我想获得:

Client
Manager
Sub

我知道有

rs.Filter
,但我不确定是否可以选择与之不同的。

我也知道我可以克隆这个记录集:

Dim rs_clone As ADODB.Recordset
Set rs_clone = New ADODB.Recordset
rs_clone = rs.getrows()

是否可以仅克隆不同的记录?或者有更好的办法吗?谢谢

sql vba excel recordset
2个回答
4
投票

在数据库中触发 sql 字符串为您提供了很大的空间来选择您想要返回的内容

小示例(在生产代码中使用我更喜欢的后期绑定),我要求从表列中获取不同的列表

MyColumn

Dim cn As Object
Dim rs As Object

Set cn = CreateObject("ADODB.Connection")
cn.Open strConn
cn.CommandTimeout = 0

Set rs = CreateObject("ADODB.Recordset")
Set rs.ActiveConnection = cn


'=====================
rs.Open "SELECT Distinct MyColumn AS C FROM myTable"

strConn
需要设置为正确的连接字符串。


编辑

在这篇文章的帮助下无法在数据库中触发

sql
字符串vba:从数组中获取唯一值我有以下解决方案。

如果您更喜欢早期绑定,则需要参考以下内容:

  • Microsoft ActiveX 数据对象(我使用 6.1 库)
  • Microsoft Scripting 运行时(这样我们就可以使用字典)

代码如下:

Option Explicit

Global Const strConn As String = _
    "PROVIDER=MySQLprovider;" & _
    "P*SSWORD=MyPword;" & _
    "USER ID=MyLogin;" & _
    "INITIAL CATALOG=MyDB;" & _
    "DATA SOURCE=MyServer;" & _
    "USE PROCEDURE FOR PREPARE=1;" & _
    "AUTO TRANSLATE=True;"


Sub getDistinctRecords()

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionTimeout = 0
cn.Open strConn

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn

'>>this mimics your record set with non-distinct members
rs.Open _
    "SELECT 'a' as MyCol UNION ALL " & _
    "SELECT 'a' as MyCol UNION ALL " & _
    "SELECT 'b' as MyCol UNION ALL " & _
    "SELECT 'b' as MyCol"

Dim Arr() As Variant
Arr = rs.GetRows() 

Dim d As Scripting.Dictionary
Set d = New Scripting.Dictionary

Dim i As Long
For i = LBound(Arr, 2) To UBound(Arr, 2)
    d(Arr(0, i)) = 1
Next i

Dim v As Variant
For Each v In d.Keys()

    '>>d.Keys() is a Variant array of the unique values in myArray.
    '>>v will iterate through each of them.

    '>>to print to the immediate window
    Debug.Print v
Next v

'=====================
     'tidy up connection
On Error Resume Next
    Set rs.ActiveConnection = Nothing
On Error GoTo 0

If Not (rs Is Nothing) Then
    If (rs.State And 1) = 1 Then rs.Close
    Set rs = Nothing
End If
If Not (cn Is Nothing) Then
    If (cn.State And 1) = 1 Then cn.Close
    Set cn = Nothing
End If

End Sub

0
投票

当我不想再次拉取记录集时,我进行了排序和循环。 如果您的第二个字段称为“位置”:

dim position
rs.sort("Position")
do until rs.EOF
    position = rs.fields("Position")
    response.write(position)
    response.write("<br />")
    do
        rs.moveNext
    loop while rs.fields("Position") = position
loop
© www.soinside.com 2019 - 2024. All rights reserved.