Excel 在自定义集合类中查找项的更好方法是For循环For索引

我正在学习如何在VBA中为一个键存储多个值。我的研究使我利用了一个定制的集合类

我让它在理论上工作，然后在实践中，我想根据键查找值，但只能通过“索引号”来完成。然后我生成了一个

属性

来返回索引号，但这意味着如果我必须循环键，每个键都将循环整个集合，以在前进之前找到索引号。这似乎需要太多的计算，我想知道是否有一种方法可以使用dicitonary key/value设置来存储Keys索引，并在Collection类中进行所有设置，这样我就可以通过字典中的索引直接调用Keys值

Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p, LastName 
End Sub
Property Get ItemByLastName(LastName As String) As clsPersons
   Set ItemByLastName = Persons(LastName)
End Property

以下是我目前的代码：

模块：

'https://www.wiseowl.co.uk/blog/s239/collections.htm
Sub CreatePeople()

 Dim p1 As New clsPersons, p2 As New clsPersons, p3 As New clsPersons

 With p1
  .FirstName = "Rita"
  .LastName = "Smith"
 End With

 With p2
  .FirstName = "Sue"
  .LastName = "Jones"
 End With
 
  With p3
  .FirstName = "Bob"
  .LastName = "Brown"
 End With
 
 Debug.Print p1.FirstName, p1.LastName, p1.FullName
 Debug.Print p1.FullName, p2.FullName, p3.FullName

End Sub
Sub CreatePersonsCollectionSafer()
 Dim Persons As New clsPersons

 Persons.Add "Rita", "Smith"
 Persons.Add "Sue", "Jones"
 Persons.Add "Bob", "Brown"
  
 Dim Person As clsPersons
 Dim PersonNumber As Integer
 Debug.Print Persons.Count
 For PersonNumber = 1 To Persons.Count
  Debug.Print Persons.Item(PersonNumber).FullName
 Next PersonNumber
 
 Dim LastName As String
 LastName = "Brown"
 Debug.Print "Last Name = " & LastName & " & First Name = " & Persons.ItemByLastName(LastName).FirstName
 
End Sub

Option Explicit
Private Persons As New Collection
Private Person As clsPersons
Public FirstName As String
Public LastName As String
''Subs
Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p

End Sub

Sub Remove(NameOrNumber As Variant)
 Persons.Remove NameOrNumber
End Sub
''EndSubs

''Properties

Property Get Count() As Long
 Count = Persons.Count
End Property

Property Get Item(Index As Variant) As clsPersons
 Set Item = Persons(Index)
End Property

Property Get FullName() As String
 FullName = FirstName & " " & LastName
End Property

Property Get Items() As Collection
 Set Items = Persons
End Property

Property Get ItemByLastName(LastName As String) As clsPersons
 Dim PersonsIndex As Integer
 For PersonsIndex = 1 To Persons.Count
  Debug.Print Persons.Item(PersonsIndex).LastName
  If Persons.Item(PersonsIndex).LastName = LastName Then
   Set ItemByLastName = Persons(PersonsIndex)
   Exit For
  End If
 Next PersonsIndex
End Property

''EndProperties

---

类（clsPersons）：

'https://www.wiseowl.co.uk/blog/s239/collections.htm
Sub CreatePeople()

 Dim p1 As New clsPersons, p2 As New clsPersons, p3 As New clsPersons

 With p1
  .FirstName = "Rita"
  .LastName = "Smith"
 End With

 With p2
  .FirstName = "Sue"
  .LastName = "Jones"
 End With
 
  With p3
  .FirstName = "Bob"
  .LastName = "Brown"
 End With
 
 Debug.Print p1.FirstName, p1.LastName, p1.FullName
 Debug.Print p1.FullName, p2.FullName, p3.FullName

End Sub
Sub CreatePersonsCollectionSafer()
 Dim Persons As New clsPersons

 Persons.Add "Rita", "Smith"
 Persons.Add "Sue", "Jones"
 Persons.Add "Bob", "Brown"
  
 Dim Person As clsPersons
 Dim PersonNumber As Integer
 Debug.Print Persons.Count
 For PersonNumber = 1 To Persons.Count
  Debug.Print Persons.Item(PersonNumber).FullName
 Next PersonNumber
 
 Dim LastName As String
 LastName = "Brown"
 Debug.Print "Last Name = " & LastName & " & First Name = " & Persons.ItemByLastName(LastName).FirstName
 
End Sub

Option Explicit
Private Persons As New Collection
Private Person As clsPersons
Public FirstName As String
Public LastName As String
''Subs
Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p

End Sub

Sub Remove(NameOrNumber As Variant)
 Persons.Remove NameOrNumber
End Sub
''EndSubs

''Properties

Property Get Count() As Long
 Count = Persons.Count
End Property

Property Get Item(Index As Variant) As clsPersons
 Set Item = Persons(Index)
End Property

Property Get FullName() As String
 FullName = FirstName & " " & LastName
End Property

Property Get Items() As Collection
 Set Items = Persons
End Property

Property Get ItemByLastName(LastName As String) As clsPersons
 Dim PersonsIndex As Integer
 For PersonsIndex = 1 To Persons.Count
  Debug.Print Persons.Item(PersonsIndex).LastName
  If Persons.Item(PersonsIndex).LastName = LastName Then
   Set ItemByLastName = Persons(PersonsIndex)
   Exit For
  End If
 Next PersonsIndex
End Property

''EndProperties

---

我已通过以下方式解决了此问题：

Private PersonsIndexDic As Object

Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p
 
 PersonsIndexDic.Add Key:=LastName, Item:=PersonsIndexDic.Count + 1
End Sub

Property Get ItemByLastName(LastName As String) As clsPersons
   Set ItemByLastName = Persons(PersonsIndexDic(LastName))
End Property

测试：

---

您应该使用集合提供的密钥。你不需要额外的收藏/字典

Sub Add(FirstName As String, LastName As String)
 Dim p As New clsPersons
 
 p.FirstName = FirstName
 p.LastName = LastName

 Persons.Add p, LastName 
End Sub
Property Get ItemByLastName(LastName As String) As clsPersons
   Set ItemByLastName = Persons(LastName)
End Property

但是，您不应该在这里使用单个类。你基本上在每个人里面都有一组新的人。您应该有一个Person和一个Person类，以使代码更易于阅读和维护

还应该隐藏成员并公开getter以实现封装。在你的代码中，你可以很容易地改变一个人的名字，因此钥匙将是无用的

这里有一种不同的方法：

Person

class:

Option Explicit

Private m_firstName As String
Private m_lastName As String
Private m_initialized As Boolean

Public Function Init(ByVal firstName_ As String, ByVal lastName_ As String) As Boolean
    If m_initialized Then
        Err.Raise 5, TypeName(Me) & ".Init", "Already initialized"
    End If
    If firstName_ = vbNullString Or lastName_ = vbNullString Then Exit Function 'Returns False
    
    m_firstName = firstName_
    m_lastName = lastName_
    m_initialized = True
    
    Init = True
End Function

Property Get FirstName() As String
    FirstName = m_firstName
End Property

Property Get LastName() As String
    LastName = m_lastName
End Property

Property Get FullName() As String
    FullName = m_firstName & " " & m_lastName
End Property

Public Function Self() As Person
    Set Self = Me
End Function

Option Explicit

Private m_persons As New Collection

Public Function Add(ByVal p As Person) As Boolean
    On Error Resume Next 'Name can already exist
    m_persons.Add p, p.LastName 'Or maybe full name would be better as multiple persons can share the same last name
    Add = Err.Number = 0
    On Error GoTo 0
End Function

Public Function AddFromValues(ByVal firstName_ As String, ByVal lastName_ As String) As Boolean
    With New Person
        If Not .Init(firstName_, lastName_) Then Exit Function
        AddFromValues = Me.Add(.Self)
    End With
End Function

Public Sub Remove(ByVal indexOrLastName As Variant)
    m_persons.Remove indexOrLastName
End Sub

Public Property Get Count() As Long
    Count = m_persons.Count
End Property

Property Get Item(ByVal indexOrLastName As Variant) As Person
    Set Item = m_persons(indexOrLastName)
End Property

Property Get Items() As Collection
    Set Items = m_persons
End Property

Public Function Exists(ByVal lastName_ As String) As Boolean
    On Error Resume Next
    m_persons.Item lastName_
    Exists = (Err.Number = 0)
    On Error GoTo 0
End Function

人员

类别：

Option Explicit

Private m_firstName As String
Private m_lastName As String
Private m_initialized As Boolean

Public Function Init(ByVal firstName_ As String, ByVal lastName_ As String) As Boolean
    If m_initialized Then
        Err.Raise 5, TypeName(Me) & ".Init", "Already initialized"
    End If
    If firstName_ = vbNullString Or lastName_ = vbNullString Then Exit Function 'Returns False
    
    m_firstName = firstName_
    m_lastName = lastName_
    m_initialized = True
    
    Init = True
End Function

Property Get FirstName() As String
    FirstName = m_firstName
End Property

Property Get LastName() As String
    LastName = m_lastName
End Property

Property Get FullName() As String
    FullName = m_firstName & " " & m_lastName
End Property

Public Function Self() As Person
    Set Self = Me
End Function

Option Explicit

Private m_persons As New Collection

Public Function Add(ByVal p As Person) As Boolean
    On Error Resume Next 'Name can already exist
    m_persons.Add p, p.LastName 'Or maybe full name would be better as multiple persons can share the same last name
    Add = Err.Number = 0
    On Error GoTo 0
End Function

Public Function AddFromValues(ByVal firstName_ As String, ByVal lastName_ As String) As Boolean
    With New Person
        If Not .Init(firstName_, lastName_) Then Exit Function
        AddFromValues = Me.Add(.Self)
    End With
End Function

Public Sub Remove(ByVal indexOrLastName As Variant)
    m_persons.Remove indexOrLastName
End Sub

Public Property Get Count() As Long
    Count = m_persons.Count
End Property

Property Get Item(ByVal indexOrLastName As Variant) As Person
    Set Item = m_persons(indexOrLastName)
End Property

Property Get Items() As Collection
    Set Items = m_persons
End Property

Public Function Exists(ByVal lastName_ As String) As Boolean
    On Error Resume Next
    m_persons.Item lastName_
    Exists = (Err.Number = 0)
    On Error GoTo 0
End Function

然后是标准.bas模块中的测试代码：

Option Explicit

Public Sub CreatePeople()
    Dim p1 As New Person
    Dim p2 As New Person
    Dim p3 As New Person
    
    p1.Init "Rita", "Smith"
    p2.Init "Sue", "Jones"
    p3.Init "Bob", "Brown"
     
    Debug.Print p1.FirstName, p1.LastName, p1.FullName
    Debug.Print p1.FullName, p2.FullName, p3.FullName
End Sub

Public Sub CreatePersonsCollectionSafer()
    Dim myPersons As New Persons

    myPersons.AddFromValues "Rita", "Smith"
    myPersons.AddFromValues "Sue", "Jones"
    myPersons.AddFromValues "Bob", "Brown"

    Dim tempPerson As Person

    For Each tempPerson In myPersons.Items
        Debug.Print tempPerson.FullName
    Next tempPerson

    Dim lastNameToSearch As String
    
    lastNameToSearch = "Brown"
    Debug.Print "Last Name = " & lastNameToSearch & " & First Name = " _
        & myPersons.Item(lastNameToSearch).FirstName
End Sub

---

与集合相比，Scripting.DIctionary看起来更适合您的用例。作为一种帮助，类Person应该是“Collection”对象，该对象包含类Person的scripting.Dictionary。您还需要考虑如何处理同一姓氏和/或名字的人。提示。脚本.Dictions（集合或ArrayList）可以嵌套，因为VBA不预先生成脚本.Dictionary，其中值本身就是脚本.Dictionary。因此，我的提示是，您的集合类可能最终基于嵌套三层的Scripting.Dictionary。这只是不是我的数据的示例数据。。。更像ordernumber、orderitem、orderamount、orderdateetc@freeflow听起来太复杂了？到目前为止，这一切都很好，我确实解决了这个问题，但现在我正在努力使集合持久化/公开化。我知道集合中已经有一个密钥，但我无法通过它进行搜索。这似乎更符合逻辑。我喜欢我可以使用

Dic.Exists

但是在你的例子中，我可以确保相同的

Get Exists

属性。要清楚的是，在您的示例中，只有姓氏才是正确的键？这只是示例数据，那么我如何知道“lastname”是关键呢？或者我也可以按名字搜索吗？@FreeSoftwareServers我已经编辑了答案并添加了

Exists

方法。在我的例子中，姓氏是关键，是的。您可以创建初始方法

ItemByLastName

，该方法将

ByVal lastName\作为字符串

参数接收，其中的代码类似于

Set ItemByLastName=m_persons（lastName）

。如果你想按名字搜索，那么问问自己名字是否是唯一的。如果否，则它不能是密钥。如果是，则需要第二个集合来保存firstName-person映射，但随后需要同步集合，它将difficult@FreeSoftwareServers此外，一旦有了2个集合，就不能再公开它们（例如，

项

方法）因为一旦检索到集合，您就可以从集合中删除项，这会破坏同步。@FreesoftwareServer最后，如果您决定创建

ItemByLastName

方法，然后将键更改为全名，则需要将该方法重命名为

ItemByFullName

。不管你决定什么，只要确保事情保持同步。@FreeSoftwareServers是的，那一行定义了键。

集合的
Add
方法有4个参数。第一个是项目，第二个是关键。在我的示例中，
m_persons.Add p，p.LastName
行的作用完全相同。