Question

我编写了一个函数，其唯一目的是以连续的形式遍历所有表单，从＆＃34; Owner＆＃34;中获取名称。字段，然后创建一个仅包含唯一值（没有重复名称）的集合。

下面的代码是我目前的代码，我意识到这似乎是一种迂回的方式来做我想要的但是一些无法预料的问题阻止我按照我想要的方式这样做。因此，虽然我意识到代码不是非常有效（并且是非常粗略的编码），但是如果仅仅是为了学习体验，我想完成这条路径。这行代码总是给我一个类型不匹配错误消息。我使用了一个断行来查看这些变量在本地窗口中的含义，它们都包含一个应该相同的字符串，因此应该返回true。我似乎无法找到一种方法来使比较真正起作用。

    ElseIf var = o Then

代码（严格评论，以确保我很清楚）：

Private Sub Command39_Click()

    Dim intRecordCount As Integer
    Dim rs As DAO.Recordset
    Dim colNames As Collection
    Set colNames = New Collection

    Set rs = Me.RecordsetClone

    intRecordCount = rs.RecordCount

    DoCmd.GoToRecord , , acFirst


    If intRecordCount > 0 Then

        Dim thisCol As Collection
        Set thisCol = New Collection

        'For each record on the form
        Do While Not rs.EOF

            Dim str As String
            Dim o As Variant

            str = Me.txtOwners.Value & ""

            'If the textbox isn't empty
            If Len(str) > 0 Then

                'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
                Set thisCol = SplitNames(str)

                'Loop through all of the names found
                For Each o In thisCol

                    Dim var As Variant
                    Dim blnFound As Boolean

                    'Loop through all names in the main collection
                    For Each var In colNames

                        'If the collection is empty simply add the first name
                        If colNames.Count = 0 Then
                            blnFound = False

                        'If the collection has items check each one to see if the name is already in the collection
                        'This line is where the problem lies, I can't find anyway to compare var to o
                        ElseIf var = o Then
                            blnFound = True
                        End If

                    Next var

                    'If the name was not found in the collection add it
                    If Not blnFound Then
                       colNames.Add (o)
                    End If
                Next o

            End If

            'Go to the next record in the continuous
            DoCmd.GoToRecord , , acNext
            rs.MoveNext
        Loop

    End If


End Sub


'Accepts the name of the owners to be split
Public Function SplitNames(strNames As String) As Collection


    Dim colNames As Collection
    Dim strThisName As String

    Set colNames = New Collection

    'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
    'I realize this isn't really needed simply my OCD requires I do
    strNames = Trim(Replace(strNames, ", ", " "))

    'Create the collection of names
    colNames.Add (Split(strNames, " "))

    'Send back the collection
    Set SplitNames = colNames

End Function

更新 - 出于某种原因，我需要通过使用var（0）来访问var string propery，所以看起来var变成了自己的数组？

Answer 1

以下是将SplitNames函数修改为Dictionary对象的示例。

如果有一个Exists方法，您可以在代码中使用elsehwere，则无需使用它来确保唯一性。仅仅将引用到密钥将创建它，因此您可以使用相同的方法创建新密钥（或覆盖它，如果它存在）：

dict(key) = value

请注意，这会覆盖键/值对的值部分。但由于您的SplitNames功能仅仅是构建＆＃34;列表＆＃34;我不认为这是一个问题。为了举例，我只是为每个值分配nullstring。

我在此函数中添加了一个可选参数，允许您返回一个唯一名称的词典，或一个Collection（从Dictionary转换）。未经测试，但我认为它应该有效。如果您遇到任何问题，请告诉我。

Public Function SplitNames(strNames As String, Optional returnCollection as Boolean=False) As Object
    'returns a Dictionary of unique names, _
    ' or a Collection of unique names if optional returnCollection=True

    Dim dictNames as Object
    Dim strThisName As Variant
    Dim coll as Collection
    Set dictNames = CreateObject("Scripting.Dictionary")

    'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
    'I realize this isn't really needed simply my OCD requires I do
    strNames = Trim(Replace(strNames, ", ", " "))

    'Create the collection of names
    For Each strThisName in  Split(strNames, " ")
        dictNames(strThisName) = ""
    Next

    If Not returnCollection Then
        Set SplitNames = dictNames
    Else
        Set coll = New Collection
        For each strThisName in dictNames.Keys()
            coll.Add strThisName
        Next
        Set SplitNames = coll
    End If
End Function

所以我认为你可以减少你的程序：

Private Sub Command39_Click()

    Dim intRecordCount As Integer
    Dim rs As DAO.Recordset
    Dim dictNames As Object
    Dim collNames as Collection
    Dim str As String
    Dim o As Variant

    Set rs = Me.RecordsetClone

    intRecordCount = rs.RecordCount

    DoCmd.GoToRecord , , acFirst
    rs.MoveFirst

    If intRecordCount > 0 Then

        'For each record on the form
        Do While Not rs.EOF
            str = Me.Controls("Text27").Value & ""

            'If the textbox isn't empty

            If Len(str) > 0 Then

                'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
                Set dictNames = SplitNames(str)

                'Alternatively, if you want to work with the Collection instead:
                Set collNames = SplitNames(str, True)

            End If
        Loop
    End If
End Sub

Answer 2

以下是适用于我需要它的更新代码。我正在添加一个字符串数组（由Split（）函数创建），这是我添加的而不是字符串值本身。

Private Sub Command39_Click()

    Dim intRecordCount As Integer
    Dim rs As DAO.Recordset
    Dim dictNames As New Collection

    Set rs = Me.RecordsetClone

    intRecordCount = rs.RecordCount

    DoCmd.GoToRecord , , acFirst
    rs.MoveFirst

    If intRecordCount > 0 Then

        Dim dictTheseNames As New Collection

        'For each record on the form
        Do While Not rs.EOF

            Dim str As String
            Dim o As Variant

            str = Me.Controls("Text27").Value & ""

            'If the textbox isn't empty
            If Len(str) > 0 Then

                'Send the string containing names ("Bob, Cheryl, Jeff, Tim")
                Set dictTheseNames = SplitNames(str)

                'Loop through all of the names found
                For Each o In dictTheseNames

                    Dim var As Variant
                    Dim blnFound As Boolean
                    blnFound = False

                    'Loop through all names in the main collection
                    For Each var In dictNames

                        'If the collection is empty simply add the first name
                        If dictNames.Count = 0 Then
                            dictNames.Add (o)

                        'If the collection has items check each one to see if the name is already in the collection
                        'This line is where the problem lies, I can't find anyway to compare var to o
                        ElseIf o = var Then
                            blnFound = True
                        End If

                    Next var

                    'If the name was not found in the collection add it
                    If Not blnFound Then
                       dictNames.Add (o)
                    End If
                Next o

            End If

            'Go to the next record in the continuous
            rs.MoveNext

            If (rs.RecordCount - rs.AbsolutePosition) > 2 Then
                DoCmd.GoToRecord , , acNext
            End If

        Loop

    End If


End Sub


'Accepts the name of the owners to be split
Public Function SplitNames(strNames As String) As Collection


    Dim dictNames As New Collection
    Dim strThisName As String
    Dim strArray() As String

    Set dictNames = New Collection


    'Replaces ("Bob, Cheryl, Jeff, Tim") with ("Bob Cheryl Jeff Tim")
    'I realize this isn't really needed simply my OCD requires I do
    strNames = Trim(Replace(strNames, ", ", " "))

    'Create the array of names
    strArray = Split(strNames, " ")

    Dim o As Variant
    For Each o In strArray
        dictNames.Add (o)
    Next o

    'Send back the collection
    Set SplitNames = dictNames

End Function

比较两种变体时类型不匹配，为什么？

2 个答案: