Daten im Array löschen

Hallo,
ich muss Daten auf mehrfache weise abgleichen. Da ich sehr viele Daten verarbeiten muß, lese ich diese zunächst in eine Array ein. Nun möchte ich, wenn beim ersten Abgleich daten gefunden wurden, diese aus dem Array gelöscht werden, so daß für den darauffolgenden Abgleich nur noch die "offenen" Daten im Array enthalten sind.
So sieht mein Code bisher aus:

Sub datenabgleich()
' ARRAY01 '
' Variable für Array defninieren '
Dim ARR01DAT As Variant
Dim ARR01ZMAX As Long
Dim ARR01SMAX As Long
' maximale Anzahl Spalten für das Array festlegen '
ARR01SMAX = 10
' Ermittlung Anzahl Zeilen für Array '
tbl02.Activate
Range("A1").End(xlDown).Activate
ARR01ZMAX = ActiveCell.Row
Application.Goto Reference:=Range("A1"), Scroll:=True
' Array mit Daten befüllen '
With tbl02
ARR01DAT = .Range(.Cells(1, 1), .Cells(ARR01ZMAX, ARR01SMAX))
End With
' ARRAY02 '
' Variable für Array defninieren '
Dim ARR02DAT As Variant
Dim ARR02ZMAX As Long
Dim ARR02SMAX As Long
' maximale Anzahl Spalten für das Array festlegen '
ARR02SMAX = 10
' Ermittlung Anzahl Zeilen für Array '
tbl03.Activate
Range("A1").End(xlDown).Activate
ARR02ZMAX = ActiveCell.Row
Application.Goto Reference:=Range("A1"), Scroll:=True
' Array mit Daten befüllen '
With tbl03
ARR02DAT = .Range(.Cells(1, 1), .Cells(ARR02ZMAX, ARR02SMAX))
End With
' Datenabgleich 1 und Ausgabe bei Übereinstimmung '
NFR = 2
For i = 2 To ARR01ZMAX Step 1
For y = 2 To ARR02ZMAX Step 1
If ARR01DAT(i, 10) = ARR02DAT(y, 10) Then
tbl09.Cells(NFR, 1).Value = ARR01DAT(i, 1)
tbl09.Cells(NFR, 2).Value = ARR01DAT(i, 2)
tbl09.Cells(NFR, 3).Value = ARR01DAT(i, 3)
tbl09.Cells(NFR, 4).Value = ARR01DAT(i, 4)
tbl09.Cells(NFR, 5).Value = ARR01DAT(i, 5)
tbl09.Cells(NFR, 6).Value = ARR01DAT(i, 6)
tbl09.Cells(NFR, 7).Value = ARR01DAT(i, 7)
tbl09.Cells(NFR, 8).Value = ARR01DAT(i, 8)
tbl09.Cells(NFR, 9).Value = ARR02DAT(y, 8)
NFR = NFR + 1
End If
Next y
Next i
' Datenableich 2 und Ausgabe bei Übereinstimmung '
End Sub

Was muß ich jetzt an welcher Stelle machen, damit die gefundenen Datensätze aus dem Array (hier ARR01) gelöscht werden?
Und kann ich dann beim nächsten Datenabgleich wieder bis ARR01ZMAX suchen, weil ARR01ZMAX ist dann ja eigentlich kürzer?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten im Array löschen

17.05.2018 14:35:34

Peter(silie)

AW: Daten im Array löschen

17.05.2018 14:46:15

Lutz

Quatsch...

17.05.2018 14:47:35

Peter(silie)

PS: Guck dir bitte...

17.05.2018 14:38:28

Peter(silie)

Option Explicit Public Sub Datenabgleich() Dim sourceData As Variant Dim targetData As Variant Dim lastRow As Long Dim idx As Long Const MAX_SIZE_COLUMN As Long = 10 'Array1 lastRow = tbl02.Cells(tbl02.Rows.Count, 1).End(xlUp).Row sourceData = tbl02.Range(tbl02.Cells(1, 1), _ tbl02.Cells(lastRow, MAX_SIZE_COLUMN) _ ).Value 'Array2 lastRow = tbl03.Cells(tbl03.Rows.Count, 1).End(xlUp).Row targetData = tbl03.Range(tbl03.Cells(1, 1), _ tbl03.Cells(lastRow, MAX_SIZE_COLUMN) _ ).Value Dim i As Long Dim j As Long For i = 2 To UBound(sourceData, 2) For j = 2 To UBound(targetData, 2) If sourceData(i, 10) = targetData(j, 10) Then '...Code Reduce targetData, j, 10 End If Next j Next i End Sub ' Source = Referenz Array welches verkleinert wird ' ItemIndex = Index den wir nicht mehr haben wollen ' Dimension = Index der zweiten Dimension in welcher wir arbeiten möchten Private Sub Reduce(ByRef Source As Variant, _ ByVal ItemIndex As Long, _ ByVal Dimension As Long) Dim tmp As Variant 'Neues Array Dim i As Long 'iterator Dim idx As Long 'index 'Neu-Dimensionieren und um eins verringern ReDim tmp(LBound(Source, 1) To UBound(Source, 1) - 1, _ LBound(Source, 2) To UBound(Source, 2)) idx = LBound(tmp, 1) - 1 i = ItemIndex - 1 'Falls wir nicht beim ersten Item sind If i > idx Then 'füge alle hinzu vor dem item index For i = LBound(Source, 1) To ItemIndex - 1 idx = idx + 1 tmp(idx, Dimension) = Source(i, Dimension) Next i 'füge alle hinzu nach dem item index For i = ItemIndex + 1 To UBound(Source, 1) idx = idx + 1 tmp(idx, Dimension) = Source(i, Dimension) Next i 'Falls wir beim ersten Item sind Else 'füge alle hinzu nach dem item index For i = ItemIndex + 1 To UBound(Source, 1) idx = idx + 1 tmp(idx, Dimension) = Source(i, Dimension) Next i End If 'setze das array neu Source = tmp End Sub

Beliebteste Forumthreads (12 Monate)

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