带键的VBA多维数组？ [关闭]

Posted 2021-05-06

如何在VBA中创建如下所示的数组？其他语言相当直接。我无法弄清楚设计代码的最佳方法。我已经查看了集合，它可能会工作，除了我需要动态地在另一个集合上创建一个新集合。这是不可能的。

 contacts => array(
    'company1' => array(
        'POMain' => array(
        [0] = array(
            'Email' => '[e-mail]',
            'Name' => 'John Doe'
        ),
        [1] = array(
            'Email' => '[e-mail]',
            'Name' => 'John Doe'
        )
        ),
        'POCC' => array(
            'Email' => '[e-mail]',
            'Name' => 'John Doe'
        )
    ),
    'company2' => array(
        etcetera...
    )
)

答案

我同意Comintern的观点，有许多不同的方法来创建符合您所述要求的VBA数据结构。没有更多信息，很难或不可能知道哪种方法最适合您。

您似乎认为您不能在集合中拥有集合。这是不正确的。下面我演示一种在集合中保存集合的方法。但是，除了一次性练习外，这不是我会使用的方法。我不想成为维护程序员要求更新此方法，除非它已完整记录。

我需要一些测试数据来演示我的代码。我决定使用Excel，但这种方法适用于任何可以保存此类数据的Office产品。我的数据是：

我发现使用这些数据很容易加载数据结构。我相信宏中的文档是足够的。

从数据结构中提取值要困难得多，因为有太多级别。我使用常量来使代码难以阅读。数据结构的组件是：

• Contacts：一个集合
• Contacts.Count：Contacts中的元素数量
• Contacts(InxCntctCrnt)：来自Contacts的一个元素
• Contacts(InxCntctCrnt)(InxCntctCompN)：Contacts(InxCntctCrnt)的公司名称
• Contacts(InxCntctCrnt)(InxCntctPrsnMain)：Contacts(InxCntctCrnt)的主要人物集合
• Contacts(InxCntctCrnt)(InxCntctPrsnCC)：Contacts(InxCntctCrnt)的CC人员集合
• Contacts(InxCntctCrnt)(InxCntctPrsnMain).Count：Contacts(InxCntctCrnt)主要人物集合中的元素数量
• Contacts(InxCntctCrnt)(InxCntctPrsnCC).Count：Contacts(InxCntctCrnt)的CC人员集合中的元素数量
• Contacts(InxCntctCrnt)(InxCntctPrsnMain)(InxPrsnMainCrnt)：来自Contacts(InxCntctCrnt)的主要人物集合中的一个元素
• Contacts(InxCntctCrnt)(InxCntctPrsnCC)(InxPrsnCCCrnt)：来自Contacts(InxCntctCrnt)的CC人员集合中的一个元素
• Contacts(InxCntctCrnt)(InxCntctPrsnMain)(InxPrsnMainCrnt)(InxPrsnN)：来自Contacts(InxCntctCrnt)主要人物集合中的一个元素的人名
• Contacts(InxCntctCrnt)(InxCntctPrsnMain)(InxPrsnMainCrnt)(InxPrsnA)：来自Contacts(InxCntctCrnt)主要人物集合中的一个元素的电子邮件地址
• Contacts(InxCntctCrnt)(InxCntctPrsnCC)(InxPrsnCCCrnt)(InxPrsnN)：来自Contacts(InxCntctCrnt)的CC人员集合中的一个元素的人名
• Contacts(InxCntctCrnt)(InxCntctPrsnCC)(InxPrsnCCCrnt)(InxPrsnA)：来自Contacts(InxCntctCrnt)的CC人员集合中的一个元素的电子邮件地址

我的代码是：

Option Explicit

  ' Columns within worksheet
  Const ColNameC As Long = 1
  Const ColTypeP As Long = 2
  Const ColNameP As Long = 3
  Const ColAddrP As Long = 4
  ' First data within worksheet
  Const RowDataFirst As Long = 3

Sub Demo()

  Dim CompanyNameCrnt As String
  Dim Contacts As New Collection
  ' Each entry in Contacts is a zero-based array containing
  '  * String company name
  '  * Collection of main persons. Each entry in this collection
  '    is a zero-based array containing a person name and a person email
  '    address.
  '  * Collection of cc persons. Format same as collection of main persons
  Dim PersonsMainCrnt As Collection
  Dim PersonsCCCrnt As Collection
  Dim RowCrnt As Long
  Dim TypeCrnt As String

  CompanyNameCrnt = ""   ' No pending company

  With Worksheets("Contacts")

    RowCrnt = RowDataFirst

    Do While .Cells(RowCrnt, ColNameP).Value <> ""

      If .Cells(RowCrnt, ColNameC).Value <> "" Then
        ' Start of new company
        If CompanyNameCrnt <> "" Then
          ' Output company just finished
          Contacts.Add VBA.Array(CompanyNameCrnt, _
                                 PersonsMainCrnt, _
                                 PersonsCCCrnt)
        End If
        ' Prepare for new company
        CompanyNameCrnt = .Cells(RowCrnt, ColNameC).Value
        Set PersonsMainCrnt = New Collection
        Set PersonsCCCrnt = New Collection
      End If
      If .Cells(RowCrnt, ColTypeP).Value <> "" Then
        ' New type of person
        TypeCrnt = .Cells(RowCrnt, ColTypeP).Value
      End If
      If TypeCrnt = "Main" Then
        PersonsMainCrnt.Add VBA.Array(.Cells(RowCrnt, ColNameP).Value, _
                                      .Cells(RowCrnt, ColAddrP).Value)
      ElseIf TypeCrnt = "CC" Then
        PersonsCCCrnt.Add VBA.Array(.Cells(RowCrnt, ColNameP).Value, _
                                    .Cells(RowCrnt, ColAddrP).Value)
      Else
        Debug.Assert False    ' Unknown type
      End If

      RowCrnt = RowCrnt + 1

    Loop

    If CompanyNameCrnt <> "" Then
      ' Output final company
      Contacts.Add VBA.Array(CompanyNameCrnt, _
                             PersonsMainCrnt, _
                             PersonsCCCrnt)
    End If

  End With

  ' Indices into element of Contacts
  Const InxCntctCompN As Long = 0
  Const InxCntctPrsnMain As Long = 1
  Const InxCntctPrsnCC As Long = 2
  ' Indices into element of PersonsMain and PersonsCC
  Const InxPrsnN As Long = 0
  Const InxPrsnA As Long = 1

  Dim InxCntctCrnt As Long        ' Loop variable for Contacts
  Dim InxPrsnMainCrnt As Long     ' Loop variable for main persons
  Dim InxPrsnCCCrnt As Long       ' Loop variable for CC persons

  For InxCntctCrnt = 1 To Contacts.Count
    For InxPrsnMainCrnt = 1 To Contacts(InxCntctCrnt)(InxCntctPrsnMain).Count
      Debug.Print Contacts(InxCntctCrnt)(InxCntctCompN) & "|Main|" & _
                  Contacts(InxCntctCrnt)(InxCntctPrsnMain)(InxPrsnMainCrnt)(InxPrsnN) & "|" & _
                  Contacts(InxCntctCrnt)(InxCntctPrsnMain)(InxPrsnMainCrnt)(InxPrsnA)
    Next
    For InxPrsnCCCrnt = 1 To Contacts(InxCntctCrnt)(InxCntctPrsnCC).Count
      Debug.Print Contacts(InxCntctCrnt)(InxCntctCompN) & "| CC |" & _
                  Contacts(InxCntctCrnt)(InxCntctPrsnCC)(InxPrsnCCCrnt)(InxPrsnN) & "|" & _
                  Contacts(InxCntctCrnt)(InxCntctPrsnCC)(InxPrsnCCCrnt)(InxPrsnA)
    Next
  Next

End Sub

此代码的输出：

Company1|Main|John Doe|[e-mail]
Company1|Main|Jane Doe|[e-mail]
Company1| CC |John Brown|[e-mail]
Company1| CC |Jane Brown|[e-mail]
Company1| CC |Chris Green|[e-mail]
Company2|Main|Donald Black|[e-mail]
Company2|Main|Esther Clark|[e-mail]
Company2|Main|Francis Davis|[e-mail]
Company2| CC |George Eton|[e-mail]
Company2| CC |Harry Fox|[e-mail]
Company3|Main|Iris Grant|[e-mail]
Company3|Main|John Hammond|[e-mail]
Company3|Main|Keith Island|[e-mail]

如果不了解您的目标，我无法确定我会推荐的方法。我首选的方法是集合中的用户类型。遗憾的是，集合中不允许使用用户类型。您可以在集合中拥有类，但类具有不同的限制，这限制了它们的用途。我怀疑数组中的用户类型是最自我记录的方法。如果您认为可能有帮助，我可以提供该方法的演示。