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

Question

我正在学习如何为VBA中的键存储多个值。我的研究导致我使用自定义集合类。

我让它在理论上工作，然后在实践中，我想根据键查找值，但只能通过"索引号"来实现。然后我生成了一个Property来返回索引号，但这意味着如果我必须遍历Keys每个，每个将遍历整个集合以找到索引号，然后再继续。这似乎是太多的计算，我想知道是否有一种方法可以使用字典键/值设置来存储键索引，并在集合类中设置这一切，这样我就可以直接通过字典中的索引调用键值。

下面是我的代码:

模块:

'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

---

类(clsPersons):

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

Answer 1

应该使用集合提供的键。你不需要额外的集合/字典。

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和一个Persons类，使代码更容易阅读和维护。

还应该隐藏成员并公开getter以实现封装。在你的代码中，你可以很容易地改变一个人的名字，这样键就没用了。

这里有一个不同的方法:

Person等级:

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

Personsclass:

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

Answer 2

我已经通过以下方式解决了这个问题:

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

测试:

Dim LastName As String
LastName = "Brown"
Debug.Print "Last Name = " & LastName & " & First Name = " & Persons.ItemByLastName(LastName).FirstName