Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1200to1204
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schnellere Loesung als diese...?

Schnellere Loesung als diese...?
abu
Hallo zusammen,
hab mal wieder eine Frage und hoffe ihr koennt mir weiterhelfen.
Ich bereite ein paar Daten auf um sie anschliessend in einer Datei zu suchen und zu kopieren.
Mein Code funktioniert nur braucht er ungefaehr 2min um in einer 12000-Zeilen-Datei - 480 Datensaetze zu finden...
Gibt es eine schneller Loesung als diese?
Workbooks.Open Filename:=Pfad1
With ActiveSheet
For i = 1 To UBound(data)
Application.ScreenUpdating = False
Set SuBe = Sheets("Sheet1").Cells.Find(data(i, 1), lookat:=xlWhole)
If Not SuBe Is Nothing Then
.Cells(SuBe.Row, 44) = data(i, 2)
.Cells(SuBe.Row, 45) = data(i, 3)
.Cells(SuBe.Row, 46) = data(i, 4)
.Cells(SuBe.Row, 47) = data(i, 5)
End If
Set SuBe = Nothing
Next
End With
Ueber Ideen wuerde ich mich freuen.
Gruss
Abu

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Schnellere Loesung als diese...?
14.02.2011 16:47:16
Timo
Hallo Abu,
ich würde das so umbauen:
Application.ScreenUpdating = False
Set asht = ActiveSheet.Name
With Sheets("Sheet1")
For i = 1 To UBound(Data)
Set SuBe = .Cells.Find(Data(i, 1), lookat:=xlWhole)
If Not SuBe Is Nothing Then
r = SuBe.Row
With Sheets(asht)
.Cells(r, 44) = Data(i, 2)
.Cells(r, 45) = Data(i, 3)
.Cells(r, 46) = Data(i, 4)
.Cells(r, 47) = Data(i, 5)
Set SuBe = Nothing
End With
End If
Next i
End With
Application.ScreenUpdating = True
So wie Du es geschrieben hast, setzt VBA bei jedem Durchlauf von i die Bildschirmaktualisierung auf Aus.
Das ist ja eigentlich nur einmal außerhalb der Schleife nötig, kostet sonst unnötig Zeit.
In der If-Bedingung wird pro Zelle einmal SuBe.Row geholt - einmal holen, auf r zuweisen und r nutzen sollte eine Winzigkeit Zeit einsparen.
Konnte ich nur jetzt nicht testen.
Gruß
Timo
Anzeige
Noch langsamer als mein Code.
15.02.2011 09:07:10
abu
Hallo Timo,
danke fuer deinen Vorschlag.
Habe nun mal die Zeit gestoppt:
Mein Code: 2:56
Dein Code: 3:04
Eigentlich dachte ich auch das dein Code schneller sein muesste...
Gibt es noch eine andere Loesung? Vllt nicht mit der Find-Funktion die schneller sein koennte?
Beste Gruesse
abu
AW: Schnellere Loesung als diese...?
15.02.2011 16:22:01
Josef

Hallo Abu,
ohne den ganzen Code zu sehen ist es zwar nur Stückwerk, aber probier mal.
Dim vntValues As Variant, lngLast As Long

With ActiveSheet
  lngLast = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
  vntValues = .Range(.Cells(1, 44), .Cells(lngLast, 47))
  
  For i = 1 To UBound(Data)
    Application.ScreenUpdating = False
    Set SuBe = Sheets("Sheet1").Cells.Find(Data(i, 1), lookat:=xlWhole)
    If Not SuBe Is Nothing Then
      vntValues(SuBe.Row, 1) = Data(i, 2)
      vntValues(SuBe.Row, 2) = Data(i, 3)
      vntValues(SuBe.Row, 3) = Data(i, 4)
      vntValues(SuBe.Row, 4) = Data(i, 5)
    End If
    Set SuBe = Nothing
  Next
  
  .Range(.Cells(1, 44), .Cells(lngLast, 47)) = vntValues
End With


Gruß Sepp

Anzeige
AW: Schnellere Loesung als diese...?
15.02.2011 18:40:25
Jürgen
Hallo Abu,
ohne Dir direkt auf die Schnelle passenden Code liefern zu können (der dann doch nicht passt) hier ein paar (ungetestete) Ideen:
- zu durchsuchende Daten und das Array mit den Suchwerten sortieren und parallel durchlaufen
- statt find SVerweis bzw. application.WorksheetFunction.VLookup verwenden
- ein temporäres Blatt mit den Array-Werten und passenden Formeln (z.B. SVerweis) erstellen oder vielleicht sogar damit starten (wechselnder Zeilenzahl der zu durchsuchenden Datei kann mit der Verwendung eines Bereichsnamens begegnet werden)
Gruß, Jürgen
AW: Schnellere Loesung als diese...?
16.02.2011 16:12:40
abu
Hallo Juergen und Alle anderen,
danke fuer euer Interesse und Versuche zu helfen.
Ich denke nicht das ich da weiter komme. Mein Ueberlegeungen gehen zu einem Umstieg auf Access. Allerdings habe ich da 0 Ahnung von.
Bester Gruesse
Abu
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige