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.

gibt es einen schnelleren code?
#1
Hi Leute,

ich habe ne Datenbank mit >130000 Einträgen und möchte diese benutzen um Zelle B zu kopieren. Hier der Code
Code:
Dim rngMAT1 As Range
Dim rngMAT2 As Range
Dim dblTime As Double


dblTime = Timer
Worksheets("Arbeitsblatt").Range("G14:G98").Select
With Selection 'Nummernformat wird angepasst da er sonst einige nummern nicht finden kann.
.Value = .Value
.NumberFormat = "0"
End With

With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With

Workbooks.Open "D:\Tools\Data.xlsm"

For Each rngMAT1 In Workbooks("Test.xlsm").Worksheets("Arbeitsblatt").Range("G14:G98").Cells
For Each rngMAT2 In Workbooks("Data.xlsm").Worksheets("All").Range("A2:A132690").Cells

   If rngMAT1 = "" Then
       With Application
       .Calculation = xlCalculationAutomatic
       .EnableEvents = True
       .ScreenUpdating = True
       End With
       Application.StatusBar = "Done! within  " & Timer - dblTime & " sek"
       Workbooks("Data.xlsm").Close False
       Exit Sub
   Else
   If rngMAT1 = rngMAT2 Then
       rngMAT2.Offset(0, 1).Copy rngMAT1.Offset(0, 2)
   End If
   End If
Next
Next
       With Application
       .Calculation = xlCalculationAutomatic
       .EnableEvents = True
       .ScreenUpdating = True
       End With
       Application.StatusBar = "Done! within  " & Timer - dblTime & " sek"

Workbooks("Data.xlsm").Close False
End Sub

Das ganze braucht für 28 schleifen (suchvorgänge) 30sekunden. Vielleicht könnt ihr mir tips geben wie es schneller gehen kann, wenn überhaupt. Mir ist das schon klar dass er 3,6Mio Zellen vergleicht ;)

Vielen Dank
Antworten Top
#2
Hallöchen,

mal generell - übernimm die Daten in Arrays und vergleiche dann die Inhalte der Arrays Smile
Unter Umständen kannst Du auch statt dem kopieren ein drittes Array aufbauen und nach dem Befüllen in die entsprechende Spalte einfügen. Allerdings würden dadurch alle Zellen überschrieben, wo ggf. noch "Rester" von vorher stehen - ggf durch nix.

So was kann man auch zusammenfassen:

Worksheets("Arbeitsblatt").Range("G14:G98").Select
With Selection 'Nummernformat wird angepasst da er sonst einige nummern nicht finden kann.

zu
With Worksheets("Arbeitsblatt").Range("G14:G98")
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Hi,

es gibt sicherlich schnellere Wege (über Arrays), aber Dein Code ist per se schon etwas verkorkst. Ganz schlecht ist es, wenn in G14:G98 leere Zellen enthalten sind, das sollte nicht sein. Zudem wird sowieso der zuletzt gefundene Wert übrigbleiben, da das immer in die gleiche Zelle kopiert wird!


Code:
Sub test()


Dim rngMAT1 As Range
Dim rngMAT2 As Range
Dim dblTime As Double
Dim wkb As Workbook
Dim wks As Worksheet
Dim Zelle1 As Range
Dim Zelle2 As Range
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

dblTime = Timer
With Worksheets("Arbeitsblatt").Range("G14:G98")
    .Value = .Value
    .NumberFormat = "0"
End With

Set wkb = Workbooks.Open("D:\Tools\Data.xlsm")
Set wks = wkb.Sheets("All")
Set rngMAT1 = Workbooks("Test.xlsm").Worksheets("Arbeitsblatt").Range("G14:G98")
Set rngMAT2 = wks.Range("A2:A132690")
    For Each Zelle1 In rngMAT1
        For Each Zelle2 In rngMAT2
            If Zelle1 = Zelle2 Then
                zelle2.Offset(0, 1).Copy zelle1.Offset(0, 2)
            End If
    Next
Next
        With Application
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    Application.StatusBar = "Done! within  " & Timer - dblTime & " sek"

Workbooks("Data.xlsm").Close False
End Sub



Ich weiß nicht, ob es so schneller geht, aber es sind ein paar Fehler weg!
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#4
Hallo Edgar,

wenn er auf eine leere Zelle trifft, sollte neben ein paar anderen Aktionen das Sub abgebrochen werden Smile
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#5
Hi André,

wenn ich mir den Code ansehe, dann gehört für mich nur zu den Ungereimtheiten. Letztendlich wird doch nur beim letztmaligen Auftreten des Begriffs aus G14:G98 in "ALL!A2:A132690"
 die Zelle aus B nach I in "Arbeitsblatt" kopiert. Dafür genügt eine kleine Formel:


Code:
Wennfehler(Index([D:\Tools\Data.xlsm]All!B:B;Verweis(9;1/([D:\Tools\Data.xlsm]All!A$2:A$132690=g14);Zeile([D:\Tools\Data.xlsm]All!A$2:A$132690));"")



(ungetestet und ungeprüft)
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#6
Hallo

ich habe das gesamte Makro noch nicht verstanden.  Mir fiel aber auf das der mittlere Teil der For Next Schleife mit der Anweisung nach For Next identisch ist.  Dann sollte es auch so funktionieren, ist viel kürzer.  Ich habe auch nicht verstanden warum hier zum Schluss noch Cells steht?  Ist m.E. überflüssig, und unter uns!   So geschrieben wird der gesamte Berich aufgehoben!!  Range("G14:G98").Cells(1,1)   =  Range("G14"):  Probiert es selbst aus.
Man beachte die Feinheiten der Schreibweisen von VBA!   Range("G14:G98").Cells   Wozu dient das????

mfg  Gast 123

Code:
For Each rngMAT1 In Workbooks("Test.xlsm").Worksheets("Arbeitsblatt").Range("G14:G98")
If rngMAT1 = "" Then Exit For
For Each rngMAT2 In Workbooks("Data.xlsm").Worksheets("All").Range("A2:A132690")
  If rngMAT1 = rngMAT2 Then rngMAT2.Offset(0, 1).Copy rngMAT1.Offset(0, 2)
Next
Next
Antworten Top
#7
(23.05.2017, 15:36)Gast 123 schrieb: Man beachte die Feinheiten der Schreibweisen von VBA!   Range("G14:G98").Cells   Wozu dient das????
Moin Gast!
For Each Zelle in Range("XY")
ist jedenfalls "falscher" als
For Each Zelle in Range("XY").Cells

[Klugscheißmodus]
Cells(1, 1) ist im Übrigen auch Murks, korrekt heißt es Cells.Item(1, 1)
Dann klappt es sogar mit der Intellisense! ;)
Merke:
VBA ist eine Programmiersprache, die unsaubere Programmierung viel eher erlaubt als andere Sprachen!
(liegt wohl daran, diese einem breiten Publikum schmackhaft zu machen)
[/Klugscheißmodus]
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten Top
#8
Hallo zusammen

@Ralf   Hallo Ralf, deine Reaktion ist recht heftig und ich überlege wem ich da so heftig auf die Füsse getreten habe und warum??  Gehe ich euch als "Klugscheisser" auf die Neven ohne es selbst zu merken??  Das waere nicht gut.  Muss drüber nachdenken, denn das laesst mich sicher nicht kalt!

Zitat:For Each Zelle in Range("XY")   ist jedenfalls "falscher" als

Diese Sache verstehe ich wirklich nicht!  Ich habe diese Programmierweise damals aus Beispielen von DataBecker übernommen und es hat 20 Jahre problemlos funktioniert.  Im Augenblick verstehe ich den technischen Unterschied nicht wenn man hinten noch Cells anhaengt.  Was soll das Technisch bewirken??   Das ist mir einfach nicht klar. 

Zitat:Cells(1, 1) ist im Übrigen auch Murks, korrekt heißt es Cells.Item(1, 1)

Da stehe ich auch völlig auf dem Schlauch, denn ich kenne Item nur als Teil eines Objektes, z.B. als AddItem  Als Code für eine Zelle sehe ich es zum ersten mal.  Zum ermitelln der ersten Zelle eines Range benutzte ich bisher:  Range("A20:X100").Cells(1,1).Adress um an die 1.Zelle A20 zu kommen. Das hat immer einwandfrei geklappt.  Was bewirkt dieses Item??  Und wieso versteht Excel mich trotzdem wenn es falsch ist??

Krtiki soll ja bewirken das man seine Fehler erkennt, nur bin ich im Augenblick wirklich -sehr verwirrt- weil das bisher immer so geklappt hat.
Das wollte ich auch nicht als "Klugscheisserei" rüberbringen, weil ich immer dachte das es so richtig ist.  Wenn Nein, Okay. nehme es zur Kenntnis. 

mfg Gast 123
Antworten Top
#9
Hallöchen,

Ich denke, Ralf hat den...modus selbstironisch gemeint. Hat er glaube schon ab und zu so gebraucht
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#10
(23.05.2017, 20:07)schauan schrieb: Hat er glaube schon ab und zu so gebraucht

Yepp, ist so!

@Gast123:
Du musst Dich damit abfinden, dass ICH der Klugscheißer bin, wenn mir danach ist.
Lies bitte meinen Post [so verkehrt war der nämlich nicht] noch einmal durch und Du wirst sehen, dass ich Dich niemals kritisiert habe.

Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. 
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Antworten Top


Gehe zu:


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