Hallo zusammen,
hoffe Euch geht es allen gut! :)
Ich habe folgenden Code mit dem ich Daten per Vlookup hole, diese funktioniert toll wenn es nicht so vielen Daten sind,
Code:
Sub DatenImport()
Dim rw As Long, x As Range, loletzte As Long
Dim extwbk As Workbook, twb As Workbook
Set twb = ThisWorkbook
Set extwbk = Workbooks.Open("C:\Daten\Artikel.xlsm")
loletzte = extwbk.Worksheets("Bez. Englisch").Cells(Rows.Count, "A").End(xlUp).Row
Set x = extwbk.Worksheets("Bez. Englisch").Range("A2:C" & loletzte)
With twb.Sheets("Materialdaten")
For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(rw, 5) = Application.VLookup(.Cells(rw, 1).Value2, x, 3, False)
Next rw
End With
extwbk.Close savechanges:=False
End Sub
Ich habe nun ca. 36.000 Datensätze und mit dem Code hole ich nur den Wert aus einer Spalte! Gibt es eine Möglichkeit diese Code schneller zu machen, so daß er die 36.000 Datensätze scheller abfertigt und ich auch weitere Werte aus weitere Spalte holen kann?
Vielen Dank im Voraus
LG
Alexandra
Hallo,
ja es sollte schneller machbar sein:
1. Ansatz
die Formeln für den gesamten Range auf einmal eintragen:
ungeprüft
Code:
With twb.Sheets("Materialdaten")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
.range("E5:E" & lr).formula = "=VLookup(.Cells(rw, 1).Value2, 'Bez.Englisch'!A:C, 3, False)
End With
2. Ansatz
Beide Tabellen in ein Array laden, den Vergleich ausführen und auf einmal zurückschreiben
mfg
Zitat:2. Ansatz
Beide Tabellen in ein Array laden, den Vergleich ausführen und auf einmal zurückschreiben
Hallo Fennek,
ähm ja :)
Wir würde das aussehen?
Danke
LG
Alexandra
Code:
Sub M_snb()
with getobject(C:\Daten\Artikel.xlsm")
sn=.sheets("Bez. Englisch").usedrange.resize(,3)
.close 0
end with
With Sheets("Materialdaten").usedrange.resize(,5)
sp=.value
with createobject("scripting.dictionary"
for j=2 to ubound(sn)
.item(sn(j,1))=sn(j,3)
next
For j=2 To ubound(sp)
sp(j,5)= .item(sn(j,1))
Next
end with
.Value=sp
End With
End Sub
Hallo Fennek,
beim Ansatz 1 bekomme ich eine Fehlermeldung "Anwendungs oder Definitionsfehler"?
VG
Alexandra
Hallo snb,
vielen Dank für dein Code, er ist blitzschnell, allerdings wenn ein Artikel nicht vorhanden ist, dann wird der gefunden Wert von der Zeile drüber ausgegeben, wenn nichts gefunden(sei es der Artikel in Spalte A oder dazugehörige Wert in Spalte C) wird sollte entsprechend auch nichts ausgegeben werden!?
LG
Alexandra
Code:
if .exists(sn(j,1)) then sp(j,5)= .item(sn(j,1))
Hallo snb,
musste die Zeile noch etwas anpassen in:
Code:
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
Sub M_snb()
with getobject(C:\Daten\Artikel.xlsm")
sn=.sheets("Bez. Englisch").usedrange.resize(,3)
.close 0
end with
With Sheets("Materialdaten").usedrange.resize(,5)
sp=.value
with createobject("scripting.dictionary"
for j=2 to ubound(sn)
.item(sn(j,1))=sn(j,3)
next
For j=2 To ubound(sp)
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
Next
end with
.Value=sp
End With
End Sub
Habe ich die Zeile überhaupt richtig gemacht und eingebaut?
Der Code schaut nun so aus und funktioniert, allerdings gibt es eine Fehlermeldung "Laufzeitfehler 9 - Index ausserhalb des gültigen Bereichs" in der Zeile
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
wenn in der Datei Artikel im Blatt "Bez. Englisch" weniger Zeilen sind wie in meine Datei "Materialdaten", wenn es andersrum ist funktioniert der Code super, nur nicht so! :)
Wie kann ich das anpassen?
Vielen Dank
LG
Alexandra
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
Bittte richtig kopiieren !
Bitte, nicht jeder Zeile als Code markieren !
Hallo snb,
ich habe die Code Schaltfläche gedrück und den Code per Copy & Paste eingefügt, keine Ahnung warum jede Zeile in eigenen Fenster angezeigt wird!??
Ist das jetzt so richtig oder nicht, hast du da was geändert?
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
So kommt immer die Fehlermeldung mit dem "Laufzeitfehler 9 - Index ausserhalb des gültigen Bereichs" wie ich vorhin schon geschrieben habe?
Vielen Dank
LG
Alexandra
Hallo snb,
ich habe nun etwas rumprobiert :) , bisschen was geändert und mit diesem Code scheint es zu funktionieren:
Code:
Sub BezeichnungENG()
With GetObject("C:\Temp123\Artikel.xlsm")
sn = .Sheets("Bez. Englisch").UsedRange.Resize(, 3)
.Close 0
End With
With ThisWorkbook.Sheets("Materialdaten").UsedRange.Resize(, 5)
sp = .Value
With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
.Item(sn(j, 1)) = sn(j, 3)
Next
For j = 2 To UBound(sp)
If .exists(sp(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))
Next
End With
.Value = sp
End With
End Sub
Kannst du bitte mal drüber gucken, ob es so passt, nicht daß ich irgendwas übersehen hab!?
Vielen lieben Dank
LG
Alexandra