Zahlenreihen zusammenfassen Performanceverbesserun

Hallo
folgendes Problem:
ich habe 2 Zahlenreihen in Spalte A und B
innerhalb einer Zahlenreihe sind die Werte eindeutig
die Reihen sind sortiert.
jetzt sollen alle Werte aus Spalte B, die nicht in Spalte A vorkommen, unten an Spalte A angefügt werden, so daß eine Zahlenreihe entsteht, die jeden Wert aus Spalte A und B genau 1x enthält:
also in etwa so:
Ausgansituaton:

Ziel:

wobei die Sortierung keine Rolle spielt.
Momentan habe ich das ganze so gelöst, daß ich in Spalte C mit folgender Formel die Entsprechenden Werte mit einem Wahrheitswert markiere und unten anfüge:

=Wenn(SVerweis(B1;A:A;1;1)=B1;0;WAHR)

allerdings dauert die Berechnung dieser Formel recht lange, da die Datenmengen recht gross sind (pro Datenreihe grösser 30.000 Werte). Hat jemand eine Idee, wie man das per Makro schneller lösen kann?
mein bisheriger Code dazu sieht so aus:

with ActiveSheet.Usedrange.Columns(2).Offset(0,1)
.FormulaLocal = "=Wenn(SVerweis(B1;A:A;1;1)=B1;0;WAHR)"
.SpecialCells(xlcelltypeformulas, 4).Offset(0,-1).Copy Cells(Rows.Count, 1).end(xlup).offset(1, _
0)
.Clear
End with
columns(2).Clear

Gruß, Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Public Sub Sortierte_Unikate_mit_Dictionary() Dim objDic As Object Dim vntIn As Variant Dim L As Long Dim vntOut As Variant Dim T As Double T = Timer Workbooks.Add Tabelle1.Range("a1:a30000").Copy Destination:=ActiveWorkbook.Sheets(1).Range("A1") Tabelle1.Range("b1:b30000").Copy Destination:=ActiveWorkbook.Sheets(1).Range("A30001") 'Übergabe Werte im Range an Array vntIn = ActiveWorkbook.Sheets(1).Range("A:A").Value Application.DisplayAlerts = False ActiveWorkbook.Close Application.DisplayAlerts = True Set objDic = CreateObject("Scripting.Dictionary") For L = LBound(vntIn) To UBound(vntIn) objDic(CStr(vntIn(L, 1))) = 0 Next vntOut = objDic.keys Call QuickSort(vntOut) With ThisWorkbook.ActiveSheet .Range("D2").Resize(UBound(vntOut) + 1) = WorksheetFunction.Transpose(vntOut) .Range("D1") = Timer - T End With Set objDic = Nothing End Sub

Public Sub QuickSort(vSort As Variant, Optional ByVal lngStart As Variant, Optional ByVal _ lngEnd As Variant) If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim i As Long Dim j As Long Dim h As Variant Dim x As Variant i = lngStart: j = lngEnd x = vSort((lngStart + lngEnd) / 2) Do While (vSort(i) x): j = j - 1: Wend If (i j) If (lngStart

Beliebteste Forumthreads (12 Monate)

Zahlenreihen zusammenfassen Performanceverbesserun

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread