2D Array an 2D Array anhängen?

Hallo liebe Excel-Pros,
ich bin auf eine Frage gestossen, die nicht wirklich wichtig für ein Projekt ist, mich aber doch interessiert. Vielleicht könnt Ihr mir hier weiterhelfen?
Ich würde gerne ein 2D-Array an ein 2. 2D-Array mit gleicher 2. Dimensionierung anhängen (analog bei einem Excelbereich einen 2. Bereich mit identischer Spaltenanzahl unten anfügen, ich hoffe, so ist es klar formuliert). Dabei möchte ich wenn möglich die folgenden Vorgaben einhalten:
- Exakt gleiche Reihenfolge
- Falls ein gleicher Eintrag im 1. Array bereits existiert, soll er ausgelassen werden
- Ich möchte die 2 Arrays nicht in einem Tabellenblatt zwischenspeichern
Hintergrund: Ich habe in einer Anwendung ein Formular mit 2 Listboxen. Listbox 1 enthält Einträge aus einer Suche, Listbox 2 die bereits ausgewählten Einträge. Es wird dabei nur jeweils die "1. Spalte" der 2. Dimension angezeigt, über die restlichen "Spalten" der 2. Dimension werden so "versteckte" Attribute für die weitere Verarbeitung übergeben. Über Schaltflächen "Hinzufügen" werden die Einträge der Listbox 1 in der Listbox 2 unter den bestehenden Einträgen hinzugefügt, Doppeleinträge werden dabei übersprungen. Das funktioniert auch einwandfrei mittels 2 For-Schleifen und Listbox.AddItem. Anbei zur Info der funktionierende Code:


Private Sub cmdAddAll_Click()
Dim lIndex          As Integer
Dim lIndex2         As Integer
Dim varZaehler      As Integer
Dim varExist        As Boolean
varZaehler = 0
For lIndex2 = 0 To ListBoxLieferanten.ListCount - 1
varExist = False
For lIndex = 0 To ListBoxAuswahl.ListCount - 1
If Val(ListBoxAuswahl.List(lIndex, 9)) = Val(ListBoxLieferanten.List(lIndex2, 9)) Then varExist = True
Next lIndex
If varExist = False Then
ListBoxAuswahl.AddItem
ListBoxAuswahl.List(lIndex, 0) = ListBoxLieferanten.List(lIndex2, 0)
ListBoxAuswahl.List(lIndex, 1) = ListBoxLieferanten.List(lIndex2, 1)
ListBoxAuswahl.List(lIndex, 2) = ListBoxLieferanten.List(lIndex2, 2)
ListBoxAuswahl.List(lIndex, 3) = ListBoxLieferanten.List(lIndex2, 3)
ListBoxAuswahl.List(lIndex, 4) = ListBoxLieferanten.List(lIndex2, 4)
ListBoxAuswahl.List(lIndex, 5) = ListBoxLieferanten.List(lIndex2, 5)
ListBoxAuswahl.List(lIndex, 6) = ListBoxLieferanten.List(lIndex2, 6)
ListBoxAuswahl.List(lIndex, 7) = ListBoxLieferanten.List(lIndex2, 7)
ListBoxAuswahl.List(lIndex, 8) = ListBoxLieferanten.List(lIndex2, 8)
ListBoxAuswahl.List(lIndex, 9) = ListBoxLieferanten.List(lIndex2, 9)   ' ID
Else
varZaehler = varZaehler + 1
End If
Next lIndex2
End Sub

Mein Luxus-Problem: Wenn ohne Selektionskriterien einfach alles übernommen wird, dann können dies auch mal 10.000 Einträge sein, die übernommen werden. Und dann ist das laaaangsam;-). Ich versuche das irgendwie zu beschleunigen. Eine Idee war nun, anstelle mit den Listbox-Inhalten einfach mit 2 Arrays zu arbeiten. Die Pros werden mir wahrscheinlich sagen, dass dies keine Verbesserung bringen würde, das ist mir klar (oder?). Aber die theoretische Idee hat mich nun gepackt.
Meine Fragen: Gehe ich über ein temporäres 3. Array? Aber wie dimensioniere ich da die 1. Dimension wenn ja Doubletten rausfallen sollen? Loope ich vorher einmal durch und zähle die Doubletten?
Hat einer von Euch eine coole Idee? Danke im Voraus für Eure Ideen!
Lg
Marc

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Marc,
eine funktionierende Bsp-Datei mit Bsp-Daten mit Userform mit Listboxen könnte vielleicht helfen.
So rein theoretisch fällt mir aber schon mal dieser Codeteil auf:


For lIndex = 0 To ListBoxAuswahl.ListCount - 1
If Val(ListBoxAuswahl.List(lIndex, 9)) = Val(ListBoxLieferanten.List(lIndex2, 9)) Then varExist = True
Next lIndex

Angenommen, .ListCount-1 ist schon z Bsp 7000.
Wenn jetzt schon bei lIndex = 5 varExist = True wird, werden die übrigen 6995 Einträge weiter geprüft - obwohl nicht mehr erforderlich
Deswegen würde ich diesen Code so ändern:


For lIndex = 0 To ListBoxAuswahl.ListCount - 1
If Val(ListBoxAuswahl.List(lIndex, 9)) = Val(ListBoxLieferanten.List(lIndex2, 9)) Then
varExist = True
Exit For
End If
Next lIndex

Wird jetzt bei lIndex = 5 varExist = True, dann wird For/Next sofort abgebrochen, und weitere (unnötige) 6995 Einträge werden - nicht - mehr kontrolliert.
Bei vielen True-Treffern zu Beginn einer langen Liste kann das die Ablaufgeschwindigkeit schon erheblich steigern.
Vielleicht hilft das ja schon?
Ciao
Thorsten

Private Sub cmdAddAll_Click() Dim objDictionary As Object Dim avntArray1 As Variant, avntArray2 As Variant, avntArray3 As Variant Dim ialngIndex1 As Long, ialngIndex2 As Long, ialngIndex3 As Long Set objDictionary = CreateObject(Class:="Scripting.Dictionary") avntArray1 = ListBoxAuswahl.List avntArray2 = ListBoxLieferanten.List ReDim avntArray3(LBound(avntArray1, 2) To UBound(avntArray1, 2), _ LBound(avntArray1, 1) To UBound(avntArray1, 1) + UBound(avntArray2, 1)) For ialngIndex1 = LBound(avntArray1, 1) To UBound(avntArray1, 1) objDictionary.Item(avntArray1(ialngIndex1, 9)) = vbNullString For ialngIndex2 = LBound(avntArray1, 2) To UBound(avntArray1, 2) avntArray3(ialngIndex2, ialngIndex1) = avntArray1(ialngIndex1, ialngIndex2) Next Next ialngIndex3 = UBound(avntArray1, 1) For ialngIndex1 = LBound(avntArray2, 1) To UBound(avntArray2, 1) If Not objDictionary.Exists(avntArray2(ialngIndex1, 9)) Then ialngIndex3 = ialngIndex3 + 1 For ialngIndex2 = LBound(avntArray2, 2) To UBound(avntArray2, 2) avntArray3(ialngIndex2, ialngIndex3) = avntArray2(ialngIndex1, ialngIndex2) Next End If Next ReDim Preserve avntArray3(LBound(avntArray3, 1) To UBound(avntArray3, 1), LBound(avntArray3, 2) To ialngIndex3) ListBoxAuswahl.Column = avntArray3 Set objDictionary = Nothing End Sub

Private Sub cmdAddAll_Click() Dim i As Integer Dim j As Integer Dim Dic As Object Dim Zaehler As Integer 'Dictionary Auswahl basierend aufbauen Set Dic = CreateObject("Scripting.Dictionary") With ListBoxAuswahl For i = 0 To .ListCount - 1 If Not Dic.Exists(Val(.List(i, 9))) Then Dic.Add Val(.List(i, 9)), Val(.List(i, 9)) Next End With 'Lieferant, die nicht in Auswahl sind (also nicht in Dictionary), am Ende vom Auswahlliste einfügen With ListBoxLieferanten For i = 0 To .ListCount - 1 If Not Dic.Exists(Val(.List(i, 9))) Then ListBoxAuswahl.AddItem j = ListBoxAuswahl.ListCount - 1 ListBoxAuswahl.List(j, 0) = .List(i, 0) ListBoxAuswahl.List(j, 1) = .List(i, 1) ListBoxAuswahl.List(j, 2) = .List(i, 2) ListBoxAuswahl.List(j, 3) = .List(i, 3) ListBoxAuswahl.List(j, 4) = .List(i, 4) ListBoxAuswahl.List(j, 5) = .List(i, 5) ListBoxAuswahl.List(j, 6) = .List(i, 6) ListBoxAuswahl.List(j, 7) = .List(i, 7) ListBoxAuswahl.List(j, 8) = .List(i, 8) ListBoxAuswahl.List(j, 9) = .List(i, 9) ' ID Else Zaehler = Zaehler + 1 End If Next i End With End Sub

Private Sub cmdAddAll_Click() sn = ListBoxLieferanten.List sp = ListBoxAuswahl.List With CreateObject("scripting.dictionary") For j = 0 To UBound(sn) .Item(sn(j, 9)) = Application.Index(sn, j) Next For j = 0 To UBound(sp) .Item(sp(j, 9)) = Application.Index(sp, j) Next ListBoxAuswahl.List = Application.Index(.items, 0, 0) End With End Sub

Select Spalte1, Spalte2; ... Spalte9 aus L From Lieferant as L Union Select Spalte1, Spalte2; ... Spalte9 aus A From Auswahl as A Left Outer Join Lieferant as L On A.Spalte9 = L.Spalte9 Where L.Spalte9 is Null

Private Sub cmdAddAll_Click() sn = ListBoxLieferanten.List sp = ListBoxAuswahl.List With CreateObject("scripting.dictionary") For j = 0 To UBound(sn) .Item(sn(j, 9)) = Application.Index(sn, j + 1) Next For j = 0 To UBound(sp) .Item(sp(j, 9)) = Application.Index(sp, j + 1) Next ListBoxAuswahl.List = Application.Index(.items, 0, 0) End With End Sub

Private Sub cmdAddAll_Click() sn = ListBoxLieferanten.List sp = ListBoxAuswahl.List With CreateObject("scripting.dictionary") For j = 0 To UBound(sn) .Item(sn(j, 9)) = Application.Index(sn, j + 1) Next For j = 0 To UBound(sp) if Not .exists(sp(j,9)) then .Item(sp(j, 9)) = Application.Index(sp, j + 1) Next ListBoxAuswahl.List = Application.Index(.items, 0, 0) End With End Sub

Private Sub UserForm_Click() t0 = Timer sn = ComboBox1.List sp = ComboBox2.List With CreateObject("scripting.dictionary") For j = 0 To UBound(sn) .Item(sn(j, 1)) = Array(sn(j, 0), sn(j, 1), sn(j, 2), sn(j, 3), sn(j, 4), sn(j, 5), sn(j, 7), sn(j, 8), sn(j, 9)) Next For j = 0 To UBound(sp) If Not .exists(sp(j, 1)) Then .Item(sp(j, 1)) = Array(sp(j, 0), sp(j, 1), sp(j, 2), sp(j, 3), sp(j, 4), sp(j, 5), sp(j, 7), sp(j, 8), sp(j, 9)) Next ComboBox1.List = Application.Index(.items, 0, 0) End With MsgBox Timer - t0 End Sub

Private Sub UserForm_Click() t0 = Timer sn = ComboBox1.List sp = ComboBox2.List With CreateObject("scripting.dictionary") For j = 1 To UBound(sn) x0 = .Item(sn(j, 1)) Next For j = 1 To UBound(sp) If Not .exists(sp(j, 1)) Then x0 = .Item(sp(j, 1)) ComboBox1.AddItem n = ComboBox1.ListCount - 1 For jj = 0 To UBound(sn, 2) ComboBox1.List(n, jj) = sp(j, jj) Next End If Next End With MsgBox Timer - t0 End Sub

With Range("A1") .resize(Listbox1.LisCount, Listbox1.ColumnCount) = Listbox1.List .resize(Listbox2.LisCount, Listbox2.ColumnCount).Offest(Listbox1.ListCount)= Listbox2.List .CurrentRegion.RemoveDuplicates 1, xlno Listbox1.List = . CurrentRegion.value .CurrentRegion.clearcontents End With

Beliebteste Forumthreads (12 Monate)

snb		Nepumuk
0,1796875		0,0859375
0,171875		0,0859375
0,1796875		0,0859375

30
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2D Array an 2D Array anhängen?

30 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

30
Beiträge zum Forumthread

Beiträge zu diesem Forumthread