Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Code schneller machen, viel schneller!?
#1
Hallo zusammen,


hoffe Euch geht es allen gut!Smile

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
Antwortento top
#2
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
Antwortento top
#3
Zitat:2. Ansatz
Beide Tabellen in ein Array laden, den Vergleich ausführen und auf einmal zurückschreiben


Hallo Fennek,

ähm jaSmile  Angel

Wir würde das aussehen?

Danke
LG
Alexandra
Antwortento top
#4
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antwortento top
#5
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
Antwortento top
#6
Code:
if .exists(sn(j,1)) then sp(j,5)= .item(sn(j,1))
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antwortento top
#7
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!Smile
Wie kann ich das anpassen?

Vielen Dank
LG
Alexandra
Antwortento top
#8
If .exists(sn(j, 1)) Then sp(j, 5) = .Item(sp(j, 1))

Bittte richtig kopiieren !

Bitte, nicht jeder Zeile als Code markieren !
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antwortento top
#9
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
Antwortento top
#10
Hallo snb,

ich habe nun etwas rumprobiertSmile , 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
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste