Registriert seit: 26.09.2015
Version(en): 2013
05.02.2022, 14:49
(Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2022, 14:52 von Stefan1.)
Guten Tag zusammen Ich habe eine Excel-Tabellen mit Daten und in einer Spalte befindet sich ein eindeutiger Schlüssel (ID-Nr.). Bei einem neuen Datenimport müssen die Schlüssel abgeglichen werden und die nun veränderten Datensätze auf die richtige Zeile eingefügt werden. Das geht ganz gut und doch suche ich nach einer schnelleren, vielleicht eleganterer Lösung.
Beispiel
Dim ArrAktuell() as Variant Dim ArrImport() as Variant
Set ArrAktuell = Sheets("Data").Range("A1:C200").value Set ArrImport = ActiveSheet.Range("A1: C100").value ..... Sheets("Data").Range("A1:C200).value = ArrAktuell
... Hier vergleiche ich mit einem Loop den Schlüssel auf einen Treffer. Gibt es einen Treffer(ca. 80%), dann schreibe ich die aktuellen Daten vom arrImport in arrAktuell. Falls es kein Treffer gibt schreibe ich diese in ein separates arrNeu() und am Schluss übernehme ich diese Werte ab der Zelle "C201". Soweit so gut.
Da es viele Daten (+/- 10'000) sein können, frage ich mich, ob dies nicht schneller ginge. Zum Beispiel mit einem weiteren Schlüsselarray (ArrSchlüssel), welches nur den Schlüssel und die Zeilennummer enthält Wenn ein Treffer vorliegt, müsste dieses Array neu beschrieben werden ohne den Treffer. Nach x fachen Durchläufen wäre dieser arrSchlüssel immer kleiner und damit wären auch die Durchläufe immer schneller.
Gibt es dazu eine andere Idee. Leider kann man bei einem Array keine "Zeilen" entfernen.
Gruss und Dank Stefan
Registriert seit: 29.09.2015
Version(en): 2030,5
05.02.2022, 15:00
(Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2022, 15:00 von snb.)
Bitte
Registriert seit: 29.01.2018
Version(en): 2021
Hallo Stefan, Nicht wundern: snb möchte einfach, dass Du eine Beispieldatei hochlädst. Das könnte uns wirklich helfen, Dir zu helfen. Ansonsten würde ich z. B. vorschlagen, dass Du ein Scripting.Dictionary namens obj einsetzt. Beispiel: http://www.sulprobil.com/sbminipivot_en/Du könntest dann: 1. Deine Id's aus ArrAktuell in obj laden: Code: Dim obj As Object Set obj = CreateObject("Scripting.Dictionary") For i=LBound(ArrAktuell,1) To UBound(ArrAktuell,1) ArrAktuell(obj(Id)) =i Next i
2. ArrImport durchlaufen und prüfen, ob sich die jeweilige Id in obj befindet: Code: If obj.Exists(Id) Then ArrAktuell(obj(Id)) = ArrImport(i) Else ArrAktuell(LastEntry) = ArrImport(i) LastEntry = LastEntry + 1 End If
Viele Grüße, Bernd
Registriert seit: 29.09.2015
Version(en): 2030,5
05.02.2022, 17:13
(Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2022, 17:16 von snb.)
Verwende Arrays statt objectvariabelen: Code: sub M_snb() sn= Sheets("Data").Range("A1:C200") sp= ActiveSheet.Range("A1: C100").value with createobject("scripting.dictionary") for j=1 to ubound(sn) .item(sn(j,1))=array(sn(j,1),sn(j,2),sn(j,3)) next for j=1 to ubound(sp) .item(sp(j,1))= array(sp(j,1),sp(j,2),sp(j,3)) next
sheets("Data").range("A1:C200").resize(.count)=application.index(.items,0,0) end with End Sub
Registriert seit: 26.09.2015
Version(en): 2013
05.02.2022, 23:00
(Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2022, 23:06 von Stefan1.)
Ja, Danke Bernd
If obj.Exists(Id) Then ArrAktuell(obj(Id)) = ArrImport(i) Else ArrAktuell(LastEntry) = ArrImport(i) LastEntry = LastEntry + 1 End If
Was ich aber nicht verstehe, wie kann ich die Zeilen-Nummer erfahren? Ich muss ja bei einem Treffer die Daten aus Spalten A, B, C vom Import im ArrAktuell nachführen können. Oder ist das mit dem ArrAktuell(Obj(Id) dann quasi getan?
Gruss Stefan
Vielen Dank. Das ist ein sehr spannender Ansatz. Allerdings muss ich die Daten nicht einfach nur unten anfügen und als gesamtmenge wieder auf die Tabelle bringen, sondern bei Treffer eben die Daten in das bestehende arrAktuell (sn im Beispiel) übernehmen.
Ist das createobject("scripting.dictionary") punkto Schnelligkeit dem üblichen Array quasi überlegen?
Frage sowieso: Wie ist Eure Einschätzung zur Zukunft von VBA? Fast schade, dass es verschwinden soll? Oder?
Gruss Stefan
Registriert seit: 29.09.2015
Version(en): 2030,5
05.02.2022, 23:18
(Dieser Beitrag wurde zuletzt bearbeitet: 05.02.2022, 23:18 von snb.)
Zitat:sondern bei Treffer eben die Daten in das bestehende arrAktuell (sn im Beispiel) übernehmen Und das ist gerade was der Code (nur bei Treffern) macht.
Registriert seit: 29.01.2018
Version(en): 2021
Hallo Stefan, Natürlich muss das Scripting Dictionary erst einmal mit Code: For i=1 To Letzte_Zeile obj(CStr(Cells(i,Id_Spalte))) = i Next i
gefüllt werden. Aber dann musst Du eben nicht mehr in einer Schleife nach der Id Zeile suchen, sondern kannst mit direkt die richtige Zeile nutzen oder wenn es 0 ist als neuen Datensatz behandeln. Google mal nach Excel Assoziatives Array. Es können eben Texte als Key verwendet werden. Etwas despektierlich ausgedrückt wird VBA sicherlich länger zur Verfügung stehen, als Du benötigst, um Scripting Dictionaries zu verstehen und anzuwenden, aber vielleicht nicht bis Du eine Beispieldatei bereitstellst. Ernsthaft denke ich, dass VBA zumindest so viele Jahre bestehen bleiben wird, wie Du in Deinem jetzigen Job arbeiten wirst. Viele Grüße, Bernd
Registriert seit: 26.09.2015
Version(en): 2013
07.02.2022, 21:07
(Dieser Beitrag wurde zuletzt bearbeitet: 07.02.2022, 21:11 von Stefan1.)
Guten Tag Bernd
Ist interessant:
Ist diese Methode auch bei folgendem Code (also Import von den letzten Zeile mehrere Textfiles) schneller und besser und wenn ja wie? Ich kann leider die Datei nicht hochladen (ist in Firma gesperrt)
.... Dim arrX() as variant Dim vbLMakerXLS as string Dim objFile as object Dim strDatei as string Dim ReadLine as string
FindFiles holt alle Dateien aus einem bestimmten Laufwerk und füllt ein Array mit LW und Dateiname
LZ = Ubound(strFiles) Set oFile as Object Set objFile .. CreateObject("Scripting.FileSystemObject")
RedDim arrX(l to lZ, l To 256) For l = 1 To LZ Set oFile = objFile.OpenTextFile(sFile) sLines = Split(oFile.ReadAll, vbCrLf) ReadLine = sLines(Ubound(sLines)-1) oFile.Close For e = 0 To Ubound(sLines) arrX(Y, e) = slLines(e) Next '.... diverse Werte in Spalten von arrX werden verändert usw. Y = Y + 1 Next Sheets("Data").Range("A3:IV" & UBound(arrx() = arrX() Erase arrX
---------- Bei Deinem Code-Beispiel suche ich die ID Nummer, welche zuvor separat eingelesen wurde, wie komme ich aber zur Zeilenzahl, z.B.
Dim lRow as long
lRow = obj(Import_Id)
Ansonsten wäre ich wieder beim Beispiel von snb, wobei ich da Mühe hätte bei 256 Spalten (sorry, weil ich im Muster "nur" 3 Spalten aufgeführt habe=). Aber mit der Zeitmessung war ich beeindruckt, mein Code war bei 13.7109375 und Deine Methode (und sogar inklusiv separates Einlesen aller IDs!) war viel schneller bei 0.0078125.
Vielen Dank für Eure Bemühungen.
Registriert seit: 29.09.2015
Version(en): 2030,5
256 Spalten Code: sub M_snb() sn= Sheets("Data").Range("A1:C200") sp= ActiveSheet.Range("A1: C100").value
with createobject("scripting.dictionary") for j=1 to ubound(sn) .item(sn(j,1))=application.index(sn,j) next
for j=1 to ubound(sp) .item(sp(j,1))= application.index(sp,j) next
sheets("Data").range("A1:C200").resize(.count)=application.index(.items,0,0) end with End Sub
Registriert seit: 26.09.2015
Version(en): 2013
Vielen Dank, ich habe es nun begriffen und es läuft.
|