Vergleich zzgl. Kriterium

Sub auswahl_ergaenzen_2() ' von snb sn = Sheets("Auswahl").ListObjects(1).DataBodyRange sp = Sheets("Auswahl").ListObjects(1).DataBodyRange With CreateObject("scripting.dictionary") For J = 1 To UBound(sp) .Item(sp(J, 1)) = Array(sp(J, 16), sp(J, 17), sp(J, 18), sp(J, 19), sp(J, 20), sp(J, 21), sp(J, 22)) Next For J = 1 To UBound(sn) If .Exists(sn(J, 1)) Then sn(J, 23) = .Item(sn(J, 1))(0) sn(J, 24) = .Item(sn(J, 1))(1) sn(J, 25) = .Item(sn(J, 1))(2) sn(J, 26) = .Item(sn(J, 1))(3) sn(J, 27) = .Item(sn(J, 1))(4) sn(J, 28) = .Item(sn(J, 1))(5) sn(J, 29) = .Item(sn(J, 1))(6) End If Next End With Sheets("Auswahl").ListObjects(1).DataBodyRange = sn End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Fred,
jede Programmierer hat seine Gewonnheiten. snb benutzt gern Array als Zwischenspeicher. Ja, es ist schneller. Macht aber die Sache nicht leichter zu nachvollziehen.
Ich benutze lieber die originale Objekte und deren Eigenschaften. In dem Fall ListObjects(1).ListRows, die Daten-Zeilen eines Listobject, und .Range(i), Spalte innerhalb einer Listrow-Zeile. Wurde das Listobject nicht in Spalte A anfangen, wäre die erste Zelle der Listrow trotzdem L.Range(1) sein.
Probiere in Direktfenster:


Debug.Print Worksheets("Auswahl").ListObjects(1).Listrows(1).Range(1).Address
Debug.Print Worksheets("Auswahl").ListObjects(1).Listrows(1).Range.Range("D1:F3").Address

Die Verwendung der Excel-Range erlaubt auch die Übertragung mit Resize.
Auch die Verwendung von Late Binding:


Dim D As Object
set D = CreateObject ("Scripting.Dictionary")

anstatt Early Binding


'unter Extras, Verweise, Haken bei "Microsoft Scripting Runtime"
Dim D As New Scripting.Dictionary

bin ich kein Freund von: kein Intellisense, kein Objekt-Katalog (Ansicht, Objekt-Katalog).
Am Ende ist nur wichtig, dass Du die verschiedene Variante kennst und verstehst. Welche Du deine eigenen machst, ist egal.
Mit der Auflistung in einem Dictionary wird immer der letzten Eintrag gespeichert. In deinem Beispiel ist es für 2c6dc6bf2f2f0cb7 der Eintrag in Zeile 19 (ListRow-Zeile 9). Dafür habe ich eine -auskommentierte- Anzeige dazwischen reingequätcht.


Sub auswahl_ergaenzen_2()
'  von snb
'  Change: Yal
Dim L As ListRow
Dim D As New Dictionary
Dim Elt, Msg
With Sheets("Auswahl").ListObjects(1)
'Aufnahme der ZeilenNummer pro Wert in Spalte 1 (=A)
'Falls L.Range(1) mehrfach vorkommt, wird immer nur der letzte "gespeichert".
For Each L In .ListRows
D(L.Range(1)) = L.Index
Next
'Zeige mir den Inhalt
'        For Each Elt In D.Keys
'            Msg = Msg & vbCr & Elt & vbTab & D(E)
'        Next
'        MsgBox Mid(Msg, 2)
'Ausgabe der "letzt gespeicherten"
For Each L In .ListRows
If D.Exists(L.Range(1)) Then
If L.Range(16) = L.Range(53) And L.Range(16) = L.Range(54) Then 'P=16, BA=53, BB=54
L.Range(23).Resize(1, 7) = .ListRows(D(L.Range(1))).Range(16).Resize(1, 7)
End If
End If
Next
End With
End Sub

VG
Yal

Sub auswahl_ergaenzen_2() ' von snb ' Change: Yal Dim L As ListRow Dim D As New Dictionary Dim Elt, Msg With Sheets("Auswahl").ListObjects(1) 'Aufnahme der ZeilenNummer pro Wert in Spalte 1 (=A) 'Falls L.Range(1) mehrfach vorkommt, wird immer nur der letzte "gespeichert". For Each L In .ListRows D(L.Range(1).Value) = L.Index Next 'Zeige mir den Inhalt ' For Each Elt In D.Keys ' Msg = Msg & vbCr & Elt & vbTab & D(E) ' Next ' MsgBox Mid(Msg, 2) 'Ausgabe der "letzt gespeicherten" For Each L In .ListRows If D.Exists(L.Range(1).Value) Then If L.Range(16).Value = L.Range(53).Value And L.Range(16).Value = L.Range(54).Value Then 'P=16, BA=53, BB=54 L.Range(23).Resize(1, 7) = .ListRows(D(L.Range(1))).Range(16).Resize(1, 7).Value End If End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread