2014-09-12 46 views
0

我写了一个函数,唯一的目的是要遍历所有形式的连续形式,从“所有者”字段抢名称,然后创建一个集合了出来只包含唯一值(没有重复的名字)。下面比较两个变体时类型不匹配,为什么?

的代码是我当前的代码,我意识到这可能似乎是做我想做的,但一些不可预见的问题,阻止我这样做,我想的方式迂回的方式。所以,虽然我意识到代码并不是非常有效(而且编码非常粗糙),但如果只是为了学习体验,我想完成这条路。这行代码总是给我一个类型不匹配的错误消息。我用一个分界线,看看这些变量都在本地窗口,它们都包含这应该是相同的,因此应返回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访问VAR字符串属性格式(0),所以它看起来像不知何故var变成了自己的数组?

+1

你可以使用,而不是一个集合的Dictionary对象。字典对象有一个返回布尔值的'.Exists'方法。 – 2014-09-12 15:18:59

+0

我肯定会给你一个机会,因为如果是这样的话,我知道至少有另外4个地方可以使用那个哈哈。虽然你看到为什么这种比较似乎不起作用? – Newd 2014-09-12 15:20:46

+0

我不认为我可以使用Split功能进入字典吗? – Newd 2014-09-12 15:33:35

回答

0

以下是更新后的代码,对我有什么需要做的工作。我正在添加一个字符串数组(由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 
1

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

尽管有一个Exists方法,您可以在代码中使用elseh,但不需要使用它来确保唯一性。仅仅用同样的方法指到密钥(如果存在或覆盖它)将创建它,这样你就可以创建一个新的密钥:

dict(key) = value 

注意,这将覆盖主要的部分/值对。但是由于您的SplitNames函数仅仅构建了唯一名称的“列表”,我不认为这会是一个问题。例如起见,我简单分配nullstring每个

我添加了一个可选的参数,这个功能允许您返回唯一的名称要么字典,集合(从字典转换)。未经测试,但我认为它应该起作用。如果您有任何问题,请告诉我。

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 
相关问题