Code schneller machen, viel schneller!?

[cysu11]

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

[Fennek]

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

[cysu11]

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

[snb]

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

[cysu11]

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

[snb]

Code:

if .exists(sn(j,1)) then sp(j,5)= .item(sn(j,1))

[cysu11]

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

[snb]

If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))

Bittte richtig kopiieren !

Bitte, nicht jeder Zeile als Code markieren !

[cysu11]

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

[cysu11]

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