excel For Each循环的局限性解决方案?

piv4azn7  于 2023-08-08  发布在  其他
关注(0)|答案(5)|浏览(114)

在VBA中循环浏览项目列表时,我使用以下Code Pattern:

For Each Item In ListOfItems
    ' Do something with Item
Next Item

字符串
然而,在实际应用中,我经常需要访问迭代计数器、上一个或下一个项,或者我必须对列表中的第一个或最后一个项执行特殊的步骤。例如:

For Each Item In ListOfItems
    If Item.IsFirst Then
        ...
    End If
    Debug.Print Item.Index, Item.SomeProperty
Next Item


然而,.Index.IsFirst不是Item类的属性。因此,这不起作用。因此,我对社会的问题是:如何尽可能接近我想要的代码模式?
我知道我可以用一些额外的代码实现一个计数器。检查第一项也可以使用一些附加代码来执行。但这不是我想要的。我见过很多开发人员忘记增加计数器的bug。我想把这个从开发商手中拿出来。
同样,我也知道可以使用其他类型的循环,例如Do WhileFor i=1 To ...。这也不是我想要的我想使用直接的代码模式,它是为循环遍历列表而设计的,在我看来是For Each ...
我自己解决这个问题的尝试导致了这个模式:

For Each IterationItem In toIterationItems(ListOfItems)
    If IterationItem.IsFirst Then
        ...
    End If
    Debug.Print IterationItem.Index, IterationItem.Item.SomeProperty
Next IterationItem


函数toIterationItems接受一个CollectionDictionary,对于每个元素,它将一个IterationItem放入一个输出Collection中,然后将其返回给For Each。因此,For Each循环通过IterationItem s的Collection,而不是原始的ListOfItems
虽然这是可行的(如果需要,我可以在这里发布代码),但我不确定是否有更好的方法。我的方法有一些缺点。。

yjghlzjz

yjghlzjz1#

您的方法的优点是抽象出了对计数器管理的需求,这确实可能是bug的来源。然而,正如你提到的,它有一些缺点。它引入了另一个层次的间接性和复杂性,这可能会使经验不足的开发人员感到困惑,或者使代码更难维护。此外,它涉及创建一个全新的集合,只是为了迭代现有的集合,这是效率低下的,特别是对于大型集合。
VBA中的主要替代方案是:
1.如您所述,手动管理计数器。是的,如果不小心,它可能会导致bug,但是如果循环简单并且有很好的文档记录,风险就很小。对于复杂的循环,像IterationItem这样的抽象可能确实很有用。
1.使用不同的语言特征或结构。您提到您想使用For Each,但值得注意的是,更传统的For循环本身就支持访问索引、上一项和下一项,并且它还可以轻松地对第一项或最后一项执行特定操作。
下面是一个如何使用For循环来完成所有这些事情的示例:

Dim ListCount As Long
ListCount = ListOfItems.Count

For i = 1 To ListCount
    Dim CurrentItem As Variant
    CurrentItem = ListOfItems(i)
    
    If i = 1 Then
        ' First item
    ElseIf i = ListCount Then
        ' Last item
    Else
        ' Middle items
        Dim PreviousItem As Variant
        Dim NextItem As Variant
        PreviousItem = ListOfItems(i - 1)
        NextItem = ListOfItems(i + 1)
    End If
    
    Debug.Print i, CurrentItem.SomeProperty
Next i

字符串
如果您更喜欢For Each的可读性,并且不介意增加的复杂性和低效率,那么您的IterationItem方法可能最适合您。但是如果您想要更简单、更高效的东西,For循环是最适合您所描述的需求的。这只是可读性、简单性和效率之间的权衡问题。

ckocjqey

ckocjqey2#

作为对@VBasic2008的回应,我在这里发布了我的中间解决方案。这并不意味着解决方案,而只是作为我的问题的补充:

IterationItem类:

Option Explicit

Private Type TThis
    dicParent As Dictionary
    lngIndex As Long
End Type
Private This As TThis

Public Sub Init(ByVal adicParent As Dictionary, ByVal alngIndex As Long)
    Set This.dicParent = adicParent
    This.lngIndex = alngIndex
End Sub

Public Property Get Item() As Variant
    VariantLet Item, This.dicParent.Items(This.lngIndex - 1)
End Property

Public Property Get Key() As String
    Key = This.dicParent.Keys(This.lngIndex - 1)
End Property

Public Property Get Index() As Long
    Index = This.lngIndex
End Property

Public Property Get IsFirstItem() As Boolean
    IsFirstItem = CBool(This.lngIndex = 1)
End Property
Public Property Get IsLastItem() As Boolean
    IsLastItem = CBool(This.lngIndex = This.dicParent.Count)
End Property

Public Property Get NextItem() As Variant
    VariantLet NextItem, This.dicParent.Items(This.lngIndex)
End Property

Public Property Get PrevItem() As Variant
    VariantLet PrevItem, This.dicParent.Items(This.lngIndex - 2)
End Property

Private Sub VariantLet(ByRef Destination As Variant, ByVal Source As Variant)
    If IsObject(Source) Then
        Set Destination = Source
    Else
        Destination = Source
    End If
End Sub

字符串

函数toIterationItems

Public Function toIterationItems(ByVal InputData As Variant) As Collection
    Dim varValue As Variant, IterItem As IterationItem, Counter&
    Set toIterationItems = New Collection
    For Each varValue In InputData
        Set IterItem = New IterationItem
        Counter = Counter + 1
        IterItem.Init InputData, Counter
        toIterationItems.Add IterItem
    Next varValue
End Function


我不认为这是最佳解决方案。我在这里写这篇文章只是为了证明我的思考方向。一个缺点是我的解决方案偏离了我上面描述的目标。它还产生额外的计算负载。

xpszyzbs

xpszyzbs3#

不客气,感谢您的反馈!For Each降低了对计数器变量及其边界管理不当的风险,这是一个深思熟虑的观点。这确实是它的优势之一。
我不确定是否有一个完美的解决方案,既提供了For Each和For的所有优点,又没有任何缺点,考虑到VBA的当前功能。看起来您已经对此进行了大量的思考,并为您的IterationItem方法找到了一个相当好的折衷方案。
如果您愿意对IterationItem方法进行一些细微的修改,那么一个潜在的改进可能是使用自定义迭代器函数,而不是创建一个全新的集合。此函数将根据需要一次返回一个IterationItem,从而减少内存开销。
下面是一个如何在VBA中创建迭代器函数的示例:

Declare a public variable to hold the collection.
Public ListOfItems As Collection

' Iterator function.
Function NextIterationItem() As IterationItem
    Static i As Long
    
    If i < ListOfItems.Count Then
        i = i + 1
        Set NextIterationItem = New IterationItem
        Set NextIterationItem.Item = ListOfItems(i)
        NextIterationItem.Index = i
    Else
        Set NextIterationItem = Nothing
    End If
End Function

字符串
下面是如何在循环中使用此函数:

Dim IterationItem As IterationItem
Set IterationItem = NextIterationItem()

Do Until IterationItem Is Nothing
    If IterationItem.Index = 1 Then
        ' First item
    End If
    Debug.Print IterationItem.Index, IterationItem.Item.SomeProperty
    Set IterationItem = NextIterationItem()
Loop


但是,请注意,此示例更多的是说明性的,而非功能性的。VBA本身并不像其他一些语言那样支持迭代器,这种方法依赖于有状态函数和公共或模块级变量,这些变量本身会带来复杂性和潜在的错误。
因此,尽管探索可能性很有趣,但我要提醒的是,有时候最简单、最直接的解决方案就是最好的解决方案,即使它在各个方面都不完美。您最初使用手动管理计数器的For Each循环可能仍然是简单性、可读性和效率之间的最佳平衡点,可以满足您的需要。

5ktev3wc

5ktev3wc4#

在我的工作中,我喜欢使用自定义的、强类型的Collection类。在这些课程中,我已经实现了你所谈论的想法。下面所示的代码是使用VB6创建的,但可以将其调整为VBA。所有的代码都被精简到了基本的部分来说明这些概念。
Click事件中的程式码是将对象加入集合的典型程式码。它在ShowWidgets方法中变得更加有趣。在此方法中,我使用For Each循环遍历集合,并且可以访问您提到的所有属性。

从主窗口

Option Explicit

Private MyWidgets As Widgets 'a custom, strongly-typed collection class
Private MyWidget As Widget

Private Sub Command1_Click()
   Set MyWidgets = New Widgets
   
   'create the initial collection
   Set MyWidget = New Widget
   MyWidget.Description = "Widget 1"
   MyWidgets.Add MyWidget

   Set MyWidget = New Widget
   MyWidget.Description = "Widget 2"
   MyWidgets.Add MyWidget

   Set MyWidget = New Widget
   MyWidget.Description = "Widget 3"
   MyWidgets.Add MyWidget
   
   ShowWidgets "Create Collection"
   
   'remove item 2
   MyWidgets.Remove 2
   
   ShowWidgets "Remove an item"

   'add a new item 2
   Set MyWidget = New Widget
   MyWidget.Description = "Widget New 2"
   MyWidgets.Add MyWidget, , , 1
   
   ShowWidgets "Add an item"
End Sub

Private Sub ShowWidgets(ByVal Message As String)
   Debug.Print Message & vbCrLf

   For Each MyWidget In MyWidgets
      Debug.Print "Index: " & MyWidget.Index & vbTab & MyWidget.Description
      Debug.Print "First: " & MyWidget.isFirstItem & vbTab & "Last: " & MyWidget.isLastItem
      Debug.Print "Previous: " & (Not MyWidget.PreviousItem Is Nothing) & vbTab & _
                  "Next: " & (Not MyWidget.NextItem Is Nothing)
   Next
   
   Debug.Print vbCrLf
End Sub

字符串
让上述代码工作的挑战是在Widget和Widget之间建立一个通信机制,以便Widget可以获得所需的信息。一种方法是让Widget具有对Widget的引用。Widgets.Add方法对此进行了说明。“

小部件类

Option Explicit

Private m_Items As Collection

Private Sub Class_Initialize()
   Set m_Items = New Collection
End Sub

Private Sub Class_Terminate()
   Set m_Items = Nothing
End Sub

Public Property Get Item(ByVal Index As Variant) As Widget
   'marked as 'Default' in Procedure Attributes
   Set Item = m_Items(Index)
End Property

Public Property Get Exists(ByVal Index As Variant) As Boolean
   On Error Resume Next

   Dim w As Widget
   
   Err.Clear
   Set w = m_Items(Index)
   Exists = (Err.Number = 0)
End Property

Public Sub Add(ByVal Item As Widget, _
               Optional ByVal Key As String, _
               Optional ByVal Before As Variant, _
               Optional ByVal After As Variant)
   Set Item.Parent = Me
               
   If Not IsMissing(After) And m_Items.Count > 0 Then
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key, , After
      Else
         m_Items.Add Item, , , After
      End If
   ElseIf Not IsMissing(Before) And m_Items.Count > 0 Then
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key, Before
      Else
         m_Items.Add Item, , Before
      End If
   Else
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key
      Else
         m_Items.Add Item
      End If
   End If
   
   RenumberItems
End Sub

Public Sub Remove(ByVal Index As Variant)
   m_Items.Remove Index
   RenumberItems
End Sub

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

Public Property Get NewEnum() As IUnknown
   'marked as '-4' and 'Hide' in Procedure Attributes
   Set NewEnum = m_Items.[_NewEnum]
End Property

Private Sub RenumberItems()
   Dim i As Integer
   
   For i = 1 To m_Items.Count
      m_Items(i).Index = i
   Next
End Sub


通过引用集,Widget可以实现所需的方法。

小部件类

Option Explicit

Private m_Parent As Widgets

Private m_Index As Long
Private m_Description As String

Private Sub Class_Initialize()
'
End Sub

Private Sub Class_Terminate()
   Set m_Parent = Nothing
End Sub

Public Property Set Parent(ByVal Value As Widgets)
   Set m_Parent = Value
End Property

Public Property Let Index(ByVal Value As Long)
   m_Index = Value
End Property

Public Property Get Index() As Long
   Index = m_Index
End Property

Public Property Get isFirstItem() As Boolean
   isFirstItem = (m_Index = 1)
End Property

Public Property Get isLastItem() As Boolean
   isLastItem = (m_Index = m_Parent.Count)
End Property

Public Function NextItem() As Widget
   If m_Index < m_Parent.Count Then
      Set NextItem = m_Parent(m_Index + 1)
   Else
      Set NextItem = Nothing
   End If
End Function

Public Function PreviousItem() As Widget
   If m_Index > 1 Then
      Set PreviousItem = m_Parent(m_Index - 1)
   Else
      Set PreviousItem = Nothing
   End If
End Function

Public Property Let Description(ByVal Value As String)
   m_Description = Value
End Property

Public Property Get Description() As String
   Description = m_Description
End Property

编辑

该解可以推广到字符串、整数或对象,而不需要太多的麻烦。frmMain中的代码与最初的代码非常相似。

从主窗口

Option Explicit

Private MyItems As BetterCollection
Private MyItem As IterationItem

Private Sub Command1_Click()
   'create the collection with strings
   Set MyItems = New BetterCollection
   Set MyItem = New IterationItem
   MyItem.Item = "String 1"
   MyItems.Add MyItem

   'or create the collection with integers
   Set MyItems = New BetterCollection
   Set MyItem = New IterationItem
   MyItem.Item = 1000
   MyItems.Add MyItem

   'or create the collection with objects
   Dim MyWidget As Widget
   Set MyWidget = New Widget
   MyWidget.Description = "My Widget 1"

   Set MyItems = New BetterCollection
   Set MyItem = New IterationItem
   MyItem.Item = MyWidget
   MyItems.Add MyItem

   '.
   '.
   '.

   'and then looping for objects
   For Each MyItem In MyItems
      Debug.Print "Index: " & MyItem.Index & vbTab & MyItem.Item.Description
   Next

   'or looping for strings or integers
   For Each MyItem In MyItems
      Debug.Print "Index: " & MyItem.Index & vbTab & MyItem.Item
   Next
End Sub


除了重命名类之外,唯一重要的修改是对原始Widget类(现在名为IterationItem)的修改。我擅自用了你的VariantLet方法。

更好的集合类

Option Explicit

Private m_Items As Collection

Private Sub Class_Initialize()
   Set m_Items = New Collection
End Sub

Private Sub Class_Terminate()
   Set m_Items = Nothing
End Sub

Public Property Get Item(ByVal Index As Variant) As IterationItem
   'marked as 'Default' in Procedure Attributes
   Set Item = m_Items(Index)
End Property

Public Property Get Exists(ByVal Index As Variant) As Boolean
   On Error Resume Next

   Dim Item As IterationItem
   
   Err.Clear
   Set Item = m_Items(Index)
   Exists = (Err.Number = 0)
End Property

Public Sub Add(ByVal Item As IterationItem, _
               Optional ByVal Key As String, _
               Optional ByVal Before As Variant, _
               Optional ByVal After As Variant)
   Set Item.Parent = Me
               
   If Not IsMissing(After) And m_Items.Count > 0 Then
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key, , After
      Else
         m_Items.Add Item, , , After
      End If
   ElseIf Not IsMissing(Before) And m_Items.Count > 0 Then
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key, Before
      Else
         m_Items.Add Item, , Before
      End If
   Else
      If Not Len(Trim$(Key)) = 0 Then
         m_Items.Add Item, Key
      Else
         m_Items.Add Item
      End If
   End If
   
   RenumberItems
End Sub

Public Sub Remove(ByVal Index As Variant)
   m_Items.Remove Index
   RenumberItems
End Sub

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

Public Property Get NewEnum() As IUnknown
   'marked as '-4' and 'Hide' in Procedure Attributes
   Set NewEnum = m_Items.[_NewEnum]
End Property

Private Sub RenumberItems()
   Dim i As Integer
   
   For i = 1 To m_Items.Count
      m_Items(i).Index = i
   Next
End Sub

迭代项类

Option Explicit

Private m_Parent As BetterCollection
Private m_Item As Variant
Private m_Index As Long

Private Sub Class_Initialize()
'
End Sub

Private Sub Class_Terminate()
   Set m_Parent = Nothing
End Sub

Public Property Set Parent(ByVal Value As BetterCollection)
   Set m_Parent = Value
End Property

Public Property Let Item(ByVal Value As Variant)
   VariantLet m_Item, Value
End Property

Public Property Get Item() As Variant
   VariantLet Item, m_Item
End Property

Public Property Let Index(ByVal Value As Long)
   m_Index = Value
End Property

Public Property Get Index() As Long
   Index = m_Index
End Property

Public Property Get isFirstItem() As Boolean
   isFirstItem = (Me.Index = 1)
End Property

Public Property Get isLastItem() As Boolean
   isLastItem = (Me.Index = m_Parent.Count)
End Property

Public Function NextItem() As IterationItem
   If Me.Index < m_Parent.Count Then
      Set NextItem = m_Parent(Me.Index + 1)
   Else
      Set NextItem = Nothing
   End If
End Function

Public Function PreviousItem() As IterationItem
   If Me.Index > 1 Then
      Set PreviousItem = m_Parent(Me.Index - 1)
   Else
      Set PreviousItem = Nothing
   End If
End Function

Private Sub VariantLet(ByRef Destination As Variant, ByVal Source As Variant)
    If IsObject(Source) Then
       Set Destination = Source
    Else
       Destination = Source
    End If
End Sub


希望这段代码能为您提供一些思路。

t40tm48m

t40tm48m5#

作为对Brian M斯塔福德的回应,我将分享我改进的实现。我想讨论一下我们的方法的异同。也许,我们可以一起找到更好的。我们的共同目标是能够做到这样:
目标

For Each Item In MyCollectionOrDictionary
   If Item.IsFirstItem Then
       ...
   End If
   Debug.Print Item.Key, Item.Value, Item.Index, Item.NextValue
Next Item

字符串
标准的For Each循环既不允许访问索引,也不允许访问下一个值,它们也不提供类似IsFirstItem的内容。显然,通过额外的代码可以实现这一点,但这不是我想要的,因为这样的代码是开发人员日常业务中许多bug的来源。我也不想用标准的For循环或Do循环来替换For Each循环。Do循环总是一个选择,因为它是最通用的循环类型,但是对于迭代列表中的项,我认为For Each循环是首选。
Brian和我关于增强的For Each循环的想法有一个共同点,那就是都准备了一个列表来启用增强的循环。这些项目会由名为IterationItem的新类别执行严修所取代:

的数据
然后,IterationItem对象提供了对所需属性IsFirstItemIndexNextItem以及原始属性ValueKey的访问。

类迭代项

Option Explicit

Private Type TThis
    Key As String
    Value As Variant
    Index As Long
    PrevItem As IterationItem
    NextItem As IterationItem
End Type
Private This As TThis

Public Sub Init(ByVal List As Variant, ByVal Index As Long, ByVal PrevItem As IterationItem, ByVal NextItem As IterationItem)
    Select Case TypeName(List)
    Case "Dictionary"
        This.Key = List.Keys()(Index - 1)
        VariantLet This.Value, List.Items()(Index - 1)
    Case "Collection"
        This.Key = CStr(Index)
        VariantLet This.Value, List.Item(Index)
    Case Else 'Arrays
        If IsArray(List) Then  ' TODO: Assert number of dimensions. Currently, we assume only 1 dimension. Throws, if there are more than one.
            This.Key = CStr(Index)
            VariantLet This.Value, List(Index - 1 + LBound(List))
        Else
            Err.Raise vbObjectError, "IterationItem", "Unexpected list type:" & TypeName(List)
        End If
    End Select
    This.Index = Index
    Set This.PrevItem = PrevItem
    Set This.NextItem = NextItem
End Sub

Public Property Get Value() As Variant
    VariantLet Value, This.Value
End Property
Public Property Get NextValue() As Variant
    VariantLet NextValue, This.NextItem.Value
End Property
Public Property Get PrevValue() As Variant
    VariantLet PrevValue, This.PrevItem.Value
End Property

Public Property Get Key() As String
    Key = This.Key
End Property
Public Property Get Index() As Long
    Index = This.Index
End Property

Public Property Get IsFirstItem() As Boolean
    IsFirstItem = CBool(This.PrevItem Is Nothing)
End Property
Public Property Get IsLastItem() As Boolean
    IsLastItem = CBool(This.NextItem Is Nothing)
End Property

Private Sub VariantLet(ByRef Destination As Variant, ByVal Source As Variant)
    If IsObject(Source) Then
        Set Destination = Source
    Else
        Destination = Source
    End If
End Sub


以下函数执行从“Before”到“After”的转换。

函数迭代项

Option Explicit

'Convert a List of items into a standard VBA Collection.
'This Collection is being filled with IterationItem objects,
'which replace the original items.
'Purpose: allow 'enhanced' For Each looping over the items.
'List typically is a Collection or Dictionary, but can be any
'object with a Count property. Arrays are accepted as well.
'@param {Variant} - List: The container of the items.
'@returns {Collection} - Collection of IterationItem objects.
''Usage:
'Dim IterItem as IterationItem
'For Each IterItem In ToIterationItems(MyCollection)
'   If IterItem.IsFirstItem Then
'       ...
'   End If
'   Debug.Print IterItem.Key, IterItem.Value, IterItem.Index
'Next IterItem
Public Function ToIterationItems(ByVal List As Variant) As VBA.Collection
    Set ToIterationItems = New VBA.Collection
    
    Dim NoItems As Long
    If IsObject(List) Then
        NoItems = List.Count  ' Throws, if there is no Count property
    Else
        NoItems = UBound(List) - LBound(List) + 1 ' Throws, if List is not an array
    End If
    If NoItems = 0 Then Exit Function
    
    Dim i As Long
    For i = 1 To NoItems
        ToIterationItems.Add New IterationItem
    Next i
    
    ' Build a chained list of IterationItem instances
    Dim CurrItem As IterationItem, NextItem As IterationItem, PrevItem As IterationItem
    Set NextItem = ToIterationItems.Item(1)
    For i = 1 To NoItems
        Set PrevItem = CurrItem
        Set CurrItem = NextItem
        If i < NoItems Then
            Set NextItem = ToIterationItems.Item(i + 1)
        Else
            Set NextItem = Nothing
        End If
        CurrItem.Init List, i, PrevItem, NextItem
    Next i
End Function

用法

Dim IterItem as IterationItem
For Each IterItem In ToIterationItems(MyCollectionOrDictionary)
   If IterItem.IsFirstItem Then
       ...
   End If
   Debug.Print IterItem.Key, IterItem.Value, IterItem.Index
Next IterItem


这个用法接近我在上面设定的目标。但是,我需要在For Each语句中调用函数ToIterationItems。我使用这个模式已经有几个星期了,现在,我发现它使我的代码更清晰,更好地可读性。
讨论
在Brian的解决方案中(参见他的答案),For Each循环中的用法更接近于目标。他不需要函数ToIterationItems,但在将项目添加到集合中时,他必须付出一些额外的努力。
Brian使用强类型的自定义Collection类来保存IterationItem示例。我使用的是标准的VBA Collection类。
Brian的IterationItem示例存储对父Collection的引用。“他的一些IterationItem属性从那里检索它们的值。我只复制了每个项目的KeyValue。这样,我的方法就可以处理数组。

相关问题