Question

如何在VBA中制作如下所示的数组？每种其他语言都相当简单。我无法找出设计代码的最佳方法。我已经研究了集合，并且它可能起作用，除了我需要在另一个集合上动态创建一个新集合。这是不可能的。

 contacts => array(
    'company1' => array(
        'POMain' => array(
        [0] = array(
            'Email' => 'demo@demo.com',
            'Name' => 'John Doe'
        ),
        [1] = array(
            'Email' => 'demo@demo.com',
            'Name' => 'John Doe'
        )
        ),
        'POCC' => array(
            'Email' => 'demo@demo.com',
            'Name' => 'John Doe'
        )
    ),
    'company2' => array(
        etcetera...
    )
)

Answer 1

我同意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)
Contacts(InxCntctCrnt)(InxCntctPrsnMain).Count：Contacts(InxCntctCrnt)
Contacts(InxCntctCrnt)(InxCntctPrsnCC).Count：Contacts(InxCntctCrnt)
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)抄送人的集合中一个元素的电子邮件地址

我的代码是：

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|DoeJohn@One.com
Company1|Main|Jane Doe|DoeJane@One.com
Company1| CC |John Brown|BrownJohn@One.com
Company1| CC |Jane Brown|BrownJane@One.com
Company1| CC |Chris Green|GreenChris@One.com
Company2|Main|Donald Black|DonaldBlack@Two.com
Company2|Main|Esther Clark|EstherClark@Two.com
Company2|Main|Francis Davis|FrancisDavis@Two.com
Company2| CC |George Eton|GeorgeEton@Two.com
Company2| CC |Harry Fox|HarryFox@Two.com
Company3|Main|Iris Grant|GrantIris@Three.com
Company3|Main|John Hammond|HammondJohn@Three.com
Company3|Main|Keith Island|IslandKeith@Three.com

在不了解您的目标的情况下，我不确定我会推荐哪种方法。我的首选方法是集合中的用户类型。不幸的是，集合中不允许用户类型。您可以在集合中包含类，但是类具有不同的限制，从而限制了其用途。我怀疑数组中的用户类型将是最能自我记录的方法。如果您认为该方法可能会有所帮助，我可以提供该方法的演示。

VBA多维数组与键？

1 个答案: