AW: Fehlende und neue Artikel auflisten
26.08.2014 19:34:00
Daniel
Hi
Makrolösung geht auch, man muss dann aber schon etwas tiefer in die VBA-Trickkiste greifen.
Hier würde sich die Verwendung des Dictionary-Objektes anbieten, um das Vorhandensein in beiden Listen zu prüfen.
ist sehr schnell und eine Sortierung wie bei den Formeln ist auch nicht zwingend erforderlich.
aber alt etwas "theoretischer":
Sub testDictionary()
Dim arrMo1
Dim arrMo2
Dim arrEntf
Dim arrNeu
Dim arrK
Dim arrI
Dim dic As Object
Dim z As Long
Dim zN As Long
Dim zE As Long
arrMo1 = Range(Cells(3, 2), Cells(3, 3).End(xlDown)).Value
arrMo2 = Range(Cells(3, 5), Cells(3, 6).End(xlDown)).Value
Set dic = CreateObject("Scripting.Dictionary")
For z = 1 To UBound(arrMo1, 1)
dic(arrMo1(z, 1) & "|" & arrMo1(z, 2)) = 1
Next
For z = 1 To UBound(arrMo2, 1)
dic(arrMo2(z, 1) & "|" & arrMo2(z, 2)) = Val(dic(arrMo2(z, 1) & "|" & arrMo2(z, 2))) + 2
Next
arrK = dic.Keys
arrI = dic.Items
ReDim arrEntf(1 To UBound(arrMo1, 1), 1 To 2)
ReDim arrNeu(1 To UBound(arrMo2, 1), 1 To 2)
For z = 0 To UBound(arrK)
Select Case arrI(z)
Case 1
zE = zE + 1
arrEntf(zE, 1) = Split(arrK(z), "|")(0)
arrEntf(zE, 2) = Split(arrK(z), "|")(1)
Case 2
zN = zN + 1
arrNeu(zN, 1) = Split(arrK(z), "|")(0)
arrNeu(zN, 2) = Split(arrK(z), "|")(1)
Case Else
End Select
Next
Cells(3, 8).Resize(UBound(arrEntf, 1), UBound(arrEntf, 2)).Value = arrEntf
Cells(3, 11).Resize(UBound(arrNeu, 1), UBound(arrNeu, 2)).Value = arrNeu
End Sub
Alternativ kann man natürlich auch die von mir vorgeschlagene Formellösung per VBA nachprogrammieren.
Das ist dann vielleicht nicht ganz so schnell, aber immer noch schnell genug und etwas weniger "abstrakt" (und leichter im Einzelstep zum testen weils keine Schleifen gibt ;-) ):
Sub testFormel()
Dim Z1 As Long
Dim Z2 As Long
Z1 = Cells(Rows.Count, 2).End(xlUp).Row
Z2 = Cells(Rows.Count, 5).End(xlUp).Row
Range("B3:C" & Z1).Sort key1:=Range("B3"), order1:=xlAscending, Header:=xlNo
Range("E3:F" & Z1).Sort key1:=Range("E3"), order1:=xlAscending, Header:=xlNo
With Range("D3:D" & Z1)
.FormulaR1C1 = "=IFERROR(IF(VLOOKUP(RC[-2],R3C5:R" & Z2 & "C5,1,1)=RC[-2],"""",ROW()),ROW()) _
.Formula = .Value
End With
With Range("G3:G" & Z2)
.FormulaR1C1 = "=IFERROR(IF(VLOOKUP(RC[-2],R3C2:R" & Z1 & "C2,1,1)=RC[-2],"""",ROW()),ROW()) _
.Formula = .Value
End With
With Range("H3").Resize(WorksheetFunction.Count(Columns(4)), 2)
.Columns(1).Formula = "=INDEX(B:B,SMALL($D$3:$D$" & Z1 & ",ROW(A1)))"
.Columns(2).FormulaR1C1 = "=VLookUp(RC[-1],R3C2:R" & Z1 & "C3,2,1)"
.Formula = .Value
End With
With Range("K3").Resize(WorksheetFunction.Count(Columns(7)), 2)
.Columns(1).Formula = "=INDEX(E:E,SMALL($G$3:$G$" & Z1 & ",ROW(A1)))"
.Columns(2).Formula = "=VLookUp(RC[-1],R3C5:R" & Z1 & "C6,2,1)"
.Formula = .Value
End With
Range("D:D,G:G").ClearContents
End Sub
Gruß Daniel