Я использовал словарь и модуль класса, чтобы помочь собрать и преобразовать данные.
Он также имеет то преимущество, что его легче отслеживать и поддерживать, поскольку названные параметры более или менее очевидны.
Я также «выполнил работу» в массиве VBA, так как при любой большой базе данных скорость выполнения будет значительно выше.
В коде должно быть очевидно, где определить рабочие таблицы и диапазоны, которые вы хотите использовать для исходных данных и результатов
Обычный модуль
Option Explicit
'Set reference to Microsoft Scripting Runtime
Sub orgOrders()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim dOrds As Dictionary, cOrd As cOrder
Dim I As Long, V As Variant
Dim sKey As String
'set source and result worksheet and range
Set wsSrc = Worksheets("Sheet2")
Set wsRes = Worksheets("Sheet2")
Set rRes = wsRes.Cells(1, 10)
'read source data into array
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 5).End(xlUp))
End With
'Read into order dictionary
Set dOrds = New Dictionary
For I = 2 To UBound(vSrc, 1)
Set cOrd = New cOrder
sKey = vSrc(I, 5) 'Order ID
With cOrd
.ID = vSrc(I, 2)
.Key = vSrc(I, 1)
.Status1 = vSrc(I, 3)
.Status2 = vSrc(I, 4)
.addTrueFalse .Key, .Status1, .Status2
If Not dOrds.Exists(sKey) Then
dOrds.Add Key:=sKey, Item:=cOrd
Else
dOrds(sKey).addTrueFalse .Key, .Status1, .Status2
End If
End With
Next I
'Dim Results array
ReDim vRes(0 To dOrds.Count, 1 To 4)
'Headers
vRes(0, 1) = "Order ID"
vRes(0, 2) = "ID"
vRes(0, 3) = "TRUE"
vRes(0, 4) = "FALSE"
'Data
I = 0
For Each V In dOrds.Keys
I = I + 1
With dOrds(V)
vRes(I, 1) = V
vRes(I, 2) = .ID
vRes(I, 3) = .TrueFalse(True)
vRes(I, 4) = .TrueFalse(False)
End With
Next V
'Write results
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
.Rows(1).Font.Bold = True
With .EntireColumn
.HorizontalAlignment = xlCenter
.AutoFit
End With
End With
End Sub
Модуль класса
ПЕРЕИМЕНОВАТЬ этот модуль cOrder
Option Explicit
Private pKey As Long
Private pID As String
Private pStatus1 As Boolean
Private pStatus2 As Boolean
Private pTrueFalse As Dictionary
Public Property Get Key() As Long
Key = pKey
End Property
Public Property Let Key(Value As Long)
pKey = Value
End Property
Public Property Get ID() As String
ID = pID
End Property
Public Property Let ID(Value As String)
pID = Value
End Property
Public Property Get Status1() As Boolean
Status1 = pStatus1
End Property
Public Property Let Status1(Value As Boolean)
pStatus1 = Value
End Property
Public Property Get Status2() As Boolean
Status2 = pStatus2
End Property
Public Property Let Status2(Value As Boolean)
pStatus2 = Value
End Property
Public Function addTrueFalse(Key As Long, Status1 As Boolean, Status2 As Boolean)
If Status1 = True And Status2 = True Then
If Not pTrueFalse.Exists(True) Then
pTrueFalse.Add Key:=True, Item:=Key
Else
pTrueFalse(True) = pTrueFalse(True) & "," & Key
End If
Else
If Not pTrueFalse.Exists(False) Then
pTrueFalse.Add Key:=False, Item:=Key
Else
pTrueFalse(False) = pTrueFalse(False) & "," & Key
End If
End If
End Function
Public Property Get TrueFalse() As Dictionary
Set TrueFalse = pTrueFalse
End Property
Private Sub Class_Initialize()
Set pTrueFalse = New Dictionary
End Sub