时间戳

首页 > 解决方案 > 不同长度的嵌套 UDT

excel - 不同长度的嵌套 UDT

问题描述

你好美丽的人们，

我试图在 vba 中创建嵌套的 UDT，以便子 UDT 可以根据情况有多个实例。

下面的示例更好地解释了我正在尝试做的事情：

样本数据：

+----------+-------------+
| Customer | Transaction |
+----------+-------------+
| A        |           1 |
| B        |           2 |
| C        |           3 |
| C        |           4 |
| C        |           5 |
| D        |           6 |
| E        |           7 |
| F        |           8 |
| D        |           9 |
| E        |          10 |
+----------+-------------+

期望的结果：

我最初尝试使用类，因为我需要为 UDT 的每个“实例”跟踪许多变量。但是，由于我的数据太大，使用类的时间太长（几分钟）。

切换到 UDT 将我的运行时间缩短到几秒钟，但需要进行一些调整。

据我了解，我可以按照我尝试的方式传递 UDT 的多个“实例”，但我应该将其作为未定义长度的填充数组。不过，我无法真正解决这个问题，至少不足以提出解决方案。

我是否需要循环遍历所有数据 n 次以创建 n 个数组（在示例中为 n = 6）？这将对性能造成严重影响。有没有更优雅的解决方案？

下面的代码是我最近尝试使用的代码。

Option Explicit

Public Type Child
    transactionid As String
    det As String
End Type
Public Type Parent
    children As Child
End Type

Sub test()

ReDim transaction(1 To 10) As Child
ReDim customer(1 To 6) As Parent

Dim wk As Worksheet
Set wk = ThisWorkbook.Sheets(1)


Dim c As Integer
For c = 1 To 10
    transaction(c).det = wk.Range("G" & c + 1).Value
    transaction(c).transactionid = wk.Range("h" & c + 1).Value
Next c

Dim j As Integer
Dim i As Integer
j = 1
For i = 1 To 6
    If customer(i).children(j).transactionid <> "" Then
        'I don't even know
    End If
Next i
End Sub

我得到一个

编译错误“预期数组”

在

customer(i).children(j).transactionid

标签： excelvba

解决方案

您可以为此使用字典，不需要 UDT 或自定义类。如果您真的想使用其中一个，我们可以使用类似的概念使其工作，但这里是您使用字典的方法，以及如何遍历字典中的所有内容以获取信息。它也应该很快地填充字典：

Sub tgr()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    With ws.Range("G2", ws.Cells(ws.Rows.Count, "H").End(xlUp))
        If .Row < 2 Then Exit Sub   'No data

        Dim aData() As Variant
        aData = .Value
    End With

    Dim hCustomers As Object
    Set hCustomers = CreateObject("Scripting.Dictionary")

    Dim i As Long
    Dim hTemp As Object
    For i = LBound(aData, 1) To UBound(aData, 1)
        If Not hCustomers.Exists(aData(i, 1)) Then
            Set hTemp = CreateObject("Scripting.Dictionary")
        Else
            Set hTemp = hCustomers(aData(i, 1))
        End If
        hTemp(hTemp.Count + 1) = aData(i, 2)
        Set hCustomers(aData(i, 1)) = hTemp
        Set hTemp = Nothing
    Next i

    Dim vCustomer As Variant
    Dim vTransactionID As Variant
    For Each vCustomer In hCustomers.Keys
        For Each vTransactionID In hCustomers(vCustomer).Keys
            MsgBox "Customer: " & vCustomer & Chr(10) & _
                   "Transaction ID: " & vTransactionID & Chr(10) & _
                   "Transaction: " & hCustomers(vCustomer)(vTransactionID)
        Next vTransactionID
    Next vCustomer

End Sub

推荐阅读