Я не уверен, что ты логик c прав. Если вы говорите, что вам нужно сопоставить 2 параметра, и эти два параметра могут содержать несколько объектов, то я не вижу, как вы можете сделать что-то кроме поиска первого или последнего вхождения. Разве вам не нужен третий параметр для различения guish совпадений?
Вы увидите в примере кода ниже, я предположил, что исходные данные имеют список счетов, которые последовательные и конечные данные имеют дублированные параметры клиента и процесса. В этом случае я предположил, что сопоставление накладной на листе назначения также должно быть последовательным, ie 2-е вхождение повторяющихся средств соответствует 2-му вхождению накладной. Итак, здесь «последовательность» становится третьим параметром, но ваш может отличаться.
Также может быть проще отформатировать ваши данные в иерархическую структуру:
customer -> process -> Счет
, так что вы можете увидеть, что происходит немного проще. Classes идеально подходят для этого. За вашим кодом трудно следовать, поскольку Exit For будет гарантировать только первое совпадение, а передача l oop повторяется в верхней границе массива ArraySourceData и обрабатывает ArrayDestination (я не вижу, что вы пытаюсь сделать там, если это не ошибка).
Чтобы показать вам, что я имею в виду, создайте три класса ( Insert ~> Module Module ) с именем cCustomer, cProcess и cInvoice . Добавьте к каждому следующий код:
cCustomer
Option Explicit
Public Name As String
Public Processes As Collection
Public Sub AddInvoice(processNum As String, invoiceNum As String, invAmount As Double)
Dim process As cProcess
Dim invoice As cInvoice
On Error Resume Next
Set process = Processes(processNum)
On Error GoTo 0
If process Is Nothing Then
Set process = New cProcess
With process
.ProcessNumber = processNum
Processes.Add process, .ProcessNumber
End With
End If
Set invoice = New cInvoice
With invoice
.InvoiceNumber = invoiceNum
.Amount = invAmount
process.Invoices.Add invoice
End With
End Sub
Public Function GetProcess(num As String) As cProcess
On Error Resume Next
Set GetProcess = Processes(num)
End Function
Private Sub Class_Initialize()
Set Processes = New Collection
End Sub
cProcess
Option Explicit
Public ProcessNumber As String
Public Invoices As Collection
Public CurrentInvoiceCount As Long
Private Sub Class_Initialize()
Set Invoices = New Collection
End Sub
cInvoice
Option Explicit
Public InvoiceNumber As String
Public Amount As Double
Public ArrayIndex As Long
Следующая подпрограмма в вашем модуле будет выводить данные, как я описал выше:
Dim customers As Collection
Dim customer As cCustomer
Dim process As cProcess
Dim invoice As cInvoice
Dim srcData As Variant, dstData As Variant
Dim output() As Variant
Dim i As Long
'Populate the source data array.
'Note: just an example here, use whatever array populating code you have.
With Sheet1 'I've put some dummy data in my Sheet1.
srcData = _
.Range( _
.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp)) _
.Resize(, 12) _
.Value2
End With
'Populate the destination data array.
'Note: just an example here, use whatever array populating code you have.
With Sheet2 'I've put some dummy data in my Sheet2.
dstData = _
.Range( _
.Cells(2, "A"), _
.Cells(.Rows.Count, "A").End(xlUp)) _
.Resize(, 10) _
.Value2
End With
'Convert source array to heirarchical collections.
Set customers = New Collection
For i = 1 To UBound(srcData, 1)
Set customer = Nothing: On Error Resume Next
Set customer = customers(CStr(srcData(i, 3))): On Error GoTo 0
If customer Is Nothing Then
Set customer = New cCustomer
With customer
.Name = CStr(srcData(i, 3))
customers.Add customer, .Name
End With
End If
customer.AddInvoice CStr(srcData(i, 5)), CStr(srcData(i, 11)), CDbl(srcData(i, 12))
Next
'Match destination array.
For i = 1 To UBound(dstData, 1)
Set customer = Nothing: On Error Resume Next
Set customer = customers(CStr(dstData(i, 3))): On Error GoTo 0
If Not customer Is Nothing Then
Set process = customer.GetProcess(CStr(dstData(i, 8)))
If Not process Is Nothing Then
With process
.CurrentInvoiceCount = .CurrentInvoiceCount + 1
If .CurrentInvoiceCount > .Invoices.Count Then
MsgBox "No further invoices for [cust=" & customer.Name & ";" & process.ProcessNumber & "]"
Else
Set invoice = .Invoices(.CurrentInvoiceCount)
invoice.ArrayIndex = i
End If
End With
End If
End If
Next
'Populate the output array.
ReDim output(1 To UBound(dstData, 1), 1 To 2)
For Each customer In customers
For Each process In customer.Processes
For Each invoice In process.Invoices
With invoice
If .ArrayIndex > 0 Then
output(.ArrayIndex, 1) = .InvoiceNumber
output(.ArrayIndex, 2) = .Amount
End If
End With
Next
Next
Next
'Write array to worksheet
Sheet2.Cells(2, 9).Resize(UBound(output, 1), UBound(output, 2)).Value = output
Без просмотра некоторых примеров данных, это трудно быть уверенным, но я подозреваю, моя точка зрения такова: если только комбинация из трех параметров делает что-то уникальным, вам нужно будет сопоставить эти три параметра.