gibt es einen schnelleren code?

[rotzi]

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

[schauan]

Hallöchen,

mal generell - übernimm die Daten in Arrays und vergleiche dann die Inhalte der Arrays
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")

[BoskoBiati]

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!

[schauan]

Hallo Edgar,

wenn er auf eine leere Zelle trifft, sollte neben ein paar anderen Aktionen das Sub abgebrochen werden

[BoskoBiati]

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)

[Gast 123]

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

[RPP63]

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

[Gast 123]

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!

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. 

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

[schauan]

Hallöchen,

Ich denke, Ralf hat den...modus selbstironisch gemeint. Hat er glaube schon ab und zu so gebraucht

[RPP63]

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