Вложенные UDT с разными длинами

Question

Здравствуйте, красивые люди,

Я пытаюсь создать вложенные UDT в vba таким образом, чтобы дочерний UDT мог иметь несколько экземпляров в зависимости от случая.

Пример ниже объясняет лучшечто я пытаюсь сделать:

Пример данных:

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

Желаемые результаты:

• customer (1) .transaction (1) .transactionid = 1
• customer (2) .transaction (1) .transactionid = 2
• customer (3) .transaction (1) .transactionid = 3
• customer (3) .transaction(2) .transactionid = 4
• customer (3) .transaction (3) .transactionid = 5
• customer (4) .transaction (1) .transactionid = 6
• customer (4) .transaction (2) .transactionid = 9
• customer (5) .transaction (1) .transactionid = 7
• customer (5) .transaction (2) .transactionid= 10
• customer (6) .transaction (1) .transactionid = 8

Я изначально пытался использовать классы, так как есть много переменных, которые мне нужно отслеживать для каждого экземпляра'изUDTs.Однако из-за того, что мои данные были слишком большими, использование классов заняло слишком много времени (пару минут).

Переключение на 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

Я получаю

ошибку компиляции«Ожидаемый массив»

in

customer(i).children(j).transactionid

Answer 1

Хорошо, вот примерное представление о том, что я упомянул в комментариях.

Это загрузить данные:

Sub test()
    Dim parentdict As Object

    Dim parentcls As Parent

    Dim iter As Long
    Dim lastrow As Long

    Dim customer As String
    Dim trans As Long
    Dim transdate As Date

    Set parentdict = CreateObject("Scripting.Dictionary")


    With ActiveSheet ' Use a real sheet name
        lastrow = .Cells(.rows.count, "A").End(xlUp).row
        For iter = 2 To lastrow
            customer = .Cells(iter, "A").value
            trans = .Cells(iter, "B").value
            transdate = .Cells(iter, "C").value
                If Not parentdict.Exists(customer) Then ' Populate Parent Dictionary
                    Set parentcls = New Parent
                    parentcls.initialize transdate
                    parentdict.Add customer, parentcls
                    parentdict(customer).addtrans trans, transdate
                Else
                    parentdict(customer).addtrans trans, transdate
                End If
        Next
    End With
End Sub

Это родительский класс:

Option Explicit

Private plasttrans As Date
Private pcurrentmonth As Boolean
Private ptotaltrans As Long
Private pchilddict As Object
Private childcls As Child

Public Property Get lasttrans() As Date
    lasttrans = plasttrans
End Property

Public Property Let lasttrans(llasttrans As Date)
    plasttrans = llasttrans
End Property

Public Property Get currentmonth() As Boolean
    currentmonth = pcurrentmonth
End Property

Private Sub togglecurrent()
    If pcurrentmonth = False Then
        pcurrentmonth = True
    Else
        pcurrentmonth = False
    End If
End Sub

Public Property Get totaltrans() As Long
    totaltrans = ptotaltrans
End Property

Public Sub addtrans(transaction As Long, transactiondate As Date)
    ptotaltrans = ptotaltrans + 1
    Set childcls = New Child
    childcls.transdate = transactiondate
    pchilddict.Add transaction, childcls
    If Month(transactiondate) = Month(Date) Then
        togglecurrent
    End If
    If transactiondate > plasttrans Then
        plasttrans = transactiondate
    End If

End Sub

Public Sub initialize(transactiondate As Date)
    Set pchilddict = CreateObject("Scripting.Dictionary")
    plasttrans = transactiondate
    pcurrentmonth = False
    ptotaltrans = 0
End Sub

А вот дочерний класс (я добавил только в одном свойстве):

Option Explicit

Private ptransdate As Date

Public Property Let transdate(ltransdate As Date)
    ptransdate = ltransdate
End Property

Public Property Get transdate() As Date
    transdate = ptransdate
End Property

Идея в том, что у вас есть словарь с Key: = Customer, Item: = Parent

Родительский класс - это класс, содержащий все на уровне клиента, т. Е. Флаг текущего месяца, последняя транзакция, текущий счетчик транзакций и еще один словарь для транзакций.

Словарь транзакций - это ключ: = транзакция, элемент: = дочерний элемент

Child - это класс, содержащий все на уровне транзакции. В моем примере это просто дата, но вы можете добавить суммы в долларах или все, что вам нужно. Если вам больше ничего не нужно, вы можете просто использовать словарь в Parent и вообще отказаться от дочернего класса.

После этого вы сможете получить доступ к любой транзакции, используя номер транзакции и клиента, или каждую транзакцию с циклом и клиентом.

Answer 2

Вы можете использовать словарь для этого, не требуется 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