Question

如何使用VBA，如何在字段中的“ServiceYES”表中搜索文本字符串，例如“CHIR”服务“即可。

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

ServiceYES table

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

提前感谢您的帮助。

Answer 1

首先创建SELECT查询。

SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';

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

如果您希望按字母顺序排序，请添加ORDER BY Code_Perso。

获得满意的查询后，根据该查询打开DAO记录集，并循环显示它返回的Code_Perso值。

您无需将它们直接加载到最终阵列中。将它们添加到以逗号分隔的字符串可能更容易。之后，您可以使用Split()函数（假设您具有Access版本＆gt; = 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

Answer 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)

Answer 3

保罗，

这是我在几分钟内聚集在一起的东西。您可以将其添加到模块中的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

如何在Access中搜索表中的字段

3 个答案: