2

使用 VBA,我如何在名为"ServiceYES"的表中的"Service"字段中搜索文本字符串,例如"CHIR " 。

之后,我想保存表"ServicesYES"中存在"CHIR"的所有行的相邻字段。“ ServiceYES”表如下:

服务YES表

我基本上想在“服务”列中找到所有“CHIR”,然后将 CHIR 左侧的名称保存为数组,例如“FRANKL_L”“SANTIA_D” 。

感谢您提前提供的所有帮助。

4

3 回答 3

3

首先创建一个SELECT查询。

SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';

SELECT DISTINCT Code_Perso如果您只想要唯一值,请使用。

ORDER BY Code_Perso如果您想让它们按字母顺序排序,请添加。

获得满意的查询后,打开基于该查询的 DAO 记录集,并循环遍历Code_Perso它返回的值。

您不需要将它们直接加载到最终数组中。将它们添加到逗号分隔的字符串中可能更容易。之后,您可以使用该Split()函数(假设您的 Access 版本 >= 2000)来创建您的数组。

这是帮助您入门的示例代码。它主要是标准的样板,但它实际上可能工作......一旦你给它“你的查询”。

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
    Do While Not .EOF
        strItems = strItems & "," & !Code_Perso
        .MoveNext
    Loop
    .Close
End With
If Len(strItems) > 0 Then
    ' discard leading comma '
    strItems = Mid(strItems, 2)
    varItems = Split(strItems, ",")
Else
    MsgBox "Oops.  No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
于 2012-08-29T18:36:01.893 回答
2

我对此进行了测试,它似乎有效。此函数将提取 ServiceYes='CHIR' 的所有记录并将 Code_Person 值转储到它将返回的数组中:

Function x() As String()
    Dim rst As Recordset
    Set rst = CurrentDb.OpenRecordset( _
         "Select * from ServiceYES where Service='CHIR'")

    Dim Arr() As String
    Dim i As Integer

    While rst.EOF = False
         ReDim Preserve Arr(i)
         Arr(i) = rst.Fields("Code_Person")
         i = i + 1
    rst.MoveNext
    Wend
    x = Arr
End Function

样品用法:

Debug.Print x()(0)
于 2012-08-29T18:45:05.477 回答
1

保罗,

这是我在几分钟内拼凑起来的东西。您可以将其添加到模块中的 VBA 编辑器中。它使用一种技巧来使 RecordCount 属性正常运行。至于返回数组,您可以更新函数并创建调用例程。如果您需要那段代码,只需发表评论即可。

谢谢!

Option Compare Database

Function QueryServiceYES()
    Dim db As Database
    Dim saveItems() As String

    Set db = CurrentDb

    Dim rs As DAO.Recordset
    Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
                                "FROM ServiceYES " & _
                                "WHERE Service = 'CHIR'")

    'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
    rs.MoveLast
    rs.MoveFirst

    ReDim Preserve saveItems(rs.RecordCount) As String

    For i = 0 To rs.RecordCount - 1
        saveItems(i) = rs.Fields("Code_Perso")

        rs.MoveNext
    Next i

    'print them out
    For i = 0 To UBound(saveItems) - 1
        Debug.Print saveItems(i)
    Next i

    rs.Close
    Set rs = Nothing

    db.Close
    Set db = Nothing
End Function
于 2012-08-29T19:01:02.383 回答