Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
952to956
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
952to956
952to956
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Code beschleunigen

Code beschleunigen
21.02.2008 09:02:00
chris
Hallo VBAler,
guten morgen.
Habe eine frage würdemich sehr über Hilfe freuen...
Habe einen VBA code der ziemlich lange läuft bis zu 10 Minuten.
Seht ihr an diesem Code mit eurem fachmänischen Auge eine möglichkeit das der code schneller läuft =?
Würde mich sehr freuen.
Habe schon am anfang des subs der dieses

Sub aufruft  stehen:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
bringt aber nicht so viel.
Danke vielmals für eure Hilfe gruß Chris


Sub daten_eintragen()
On Error Resume Next
Application.ScreenUpdating = False
'hier Code zum einfügen daten in tabelle
anzwerte_in_datenbank = obj_datenbank.Worksheets("daten" & Version).Cells(obj_datenbank. _
Worksheets("daten" & Version).Rows.Count, 1).End(xlUp).Row
For z = 2 To anzwerte_in_datenbank
For zz = 0 To UBound(werte, 2)
If UCase(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1)) = UCase(werte(0, zz))  _
Then 'zum prüfen ob aktuellen nummer gleich ist mit daten im array
For s = A_s To A_e
w = s - 100
obj_datenbank.Worksheets("daten" & Version).Cells(z, s) = werte(w, zz)
Next
For s = U_s To U_e
w = s - 102
obj_datenbank.Worksheets("daten" & Version).Cells(z, s) = werte(w, zz)
Next
Exit For
Else
'Änderungsnummer nicht gleich.
End If
Next zz
Next z
On Error GoTo 0
Application.ScreenUpdating = True
End Sub


12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code beschleunigen
21.02.2008 09:35:00
Nepumuk
Hallo Chris,
sollen wir raten? Keine deiner Variable lässt uns erahnen, in welchen Dimensionen das ganze spielt. Sind die überhaupt sauber deklariert? Ich seh nämlich nicht eine Dim-Anweisung. Welchen Wert kann z.B. anzwerte_in_datenbank annehmen? Wie groß ist das Array werte ? Was verbirgt sich hinter A_s To A_e und U_s To U_e?
Sowas:
Else
'Änderungsnummer nicht gleich.
End If
Ist z.B. eine Bremse. Dann solltest du an Stelle der Funktion UCase welche einen Variant zurück gibt besser die UCase$ - Funktion benutzen welche einen String zurück gibt. Die ist etwas schnelle da du dir 10 Byte für den Variant sparst.
Weiterhin kannst du das zwar so schreiben, da ja die Value-Eigenschat die Defaulteigenschaft des Cells-Objektes ist:
obj_datenbank.Worksheets("daten" & Version).Cells(z, s) = ......
Aber Excel muss bei jedem Ansprechen erst mal in seiner Bibliothek nachsehen, welche Eigenschaft angesprochen werden solll. Und dazu benötigt es eben etwas Zeit. Also, immer hinschreiben:
obj_datenbank.Worksheets("daten" & Version).Cells(z, s).Value = .......
Gruß
Nepumuk

Anzeige
AW: Code beschleunigen
21.02.2008 09:49:00
chris
Hallo Nepumuk,
ich konnte den ganzen code nicht einfügen wäre zu viel...
Aber deine Tipps werde ich alle umsetzen.
Vielen dank und schönen Tag !

AW: Code beschleunigen
21.02.2008 10:05:17
Nepumuk
Hallo Chris,
das wird dir vielleicht die eine oder andere Sekund sparen. Aber am grundsätzlichen Problem kaum etwas ändern.
Wo du sehr viel Zeit rausholen kannst, ist das ganze auf Arrays umzustellen. Jedes mal wenn du ein Range-Objekt ansprichst, wird ja das komplette Objekt in den Speicher geladen (sicher mehrere tausende Bytes pro Zelle, da ein Range-Objekt viele Eigenschaften hat [wovon du nur eine benötigst]). In einem Array hast du nur die Werte drin (ein paar Byte pro Wert) und damit ist das ganze nach meinen Messungen rund 100.000mal schneller.
Gruß
Nepumuk

Anzeige
AW: Code beschleunigen
21.02.2008 10:02:34
chris
Hallo Nepumuk,
eine frage noch.
Bekomme bei dieser zeile einen fehler:
If UCase$(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1)).Value = UCase$(werte(0, zz)) Then
wenn ich die zeile ändere in
If UCase(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1)).Value = UCase$(werte(0, zz)) Then
geht alles.
Es liegt nur an dem $ was ist der fehler ?
fehlermeldung ist:
"Fehler beim Kompilieren
Ungültiger Bezeichner"
Danke noch einmal !

AW: Code beschleunigen
21.02.2008 10:05:17
chris
habe gerade noch etwas probiert dann kommt auch kein fehler...
Was beutet das ?
Wenn ich in dieser zeile:
If UCase$(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1)).Value = UCase$(werte(0, zz)) Then
das ".Value " entferne kommt auch kein fehler wen Ucase$
?
Danke

Anzeige
AW: Code beschleunigen
21.02.2008 10:07:26
Nepumuk
Hallo Chris,
setz einfach die Klammer richtig. Nämlich hinter Value.
Gruß
Nepumuk

AW: Code beschleunigen
21.02.2008 10:12:00
chris
Hmm danke :)

AW: Code beschleunigen
21.02.2008 11:09:00
Rudi
Hallo,
nur mal zur Demo, was passiert, wenn du die Operationen im Array machst.
In ein Modul in einer neuen Mappe:

Sub OhneArray()
Dim t As Single, rngTest As Range, rngC As Range
t = Timer
Application.ScreenUpdating = False
Set rngTest = Range("A1:T1000")
For Each rngC In rngTest
rngC.Value = rngC.Value + 10
Next
Application.ScreenUpdating = True
MsgBox Timer - t
End Sub



Sub MitArray()
Dim i As Integer, k As Integer, vntArray, t As Single
t = Timer
vntArray = Range("A1:T1000")
For i = 1 To UBound(vntArray)
For k = 1 To UBound(vntArray, 2)
vntArray(i, k) = vntArray(i, k) + 10
Next k
Next i
Range("A1:T1000") = vntArray
MsgBox Timer - t
End Sub


Und nacheinander laufen lassen.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: Code beschleunigen
21.02.2008 13:19:30
chris
Hallo Rudi,
erstaunlich wie schnell das so geht...
Aber das muss ich in meinem code erst einmal so hinbekommen...Das kann dauern :)
Danke vielmals für den tipp..
For z = 2 To anzwerte_in_datenbank
For zz = 0 To UBound(werte, 2)
If UCase$(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1).Value) = UCase$(werte(0, zz)) Then
If werte(0, zz) "" Then
For s = A_s To A_e
w = s - 100
obj_datenbank.Worksheets("daten" & Version).Cells(z, s).Value = werte(w, zz)
Next
For s = U_s To U_e
w = s - 102
obj_datenbank.Worksheets("daten" & Version).Cells(z, s).Value = werte(w, zz)
Next
Exit For
End If
End If
Next zz
Next z

Anzeige
AW: Code beschleunigen
21.02.2008 13:43:00
Rudi
Hallo,
anscheinend werden ja nur Werte geändert aber nicht hinzugefügt.
Schuss ins blaue:

Dim vntDB
vntDB = obj_datenbank.Worksheets("daten" & Version).Range("A1").CurrentRegion
For z = 2 To UBound(vntDB)
For zz = 0 To UBound(werte, 2)
If UCase$(vntDB(z, 1)) = UCase$(werte(0, zz)) Then
If werte(0, zz)  "" Then
For s = A_s To A_e
w = s - 100
vntDB(z, s) = werte(w, zz)
Next
For s = U_s To U_e
w = s - 102
vntDB(z, s).Value = werte(w, zz)
Next
Exit For
End If
End If
Next zz
Next z
obj_datenbank.Worksheets("daten" & Version).Range("A1").CurrentRegion = vntDB


Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Anzeige
AW: Code beschleunigen
21.02.2008 14:12:33
chris
Hallo das ist ja der Wahnsinn,
wie schnell du das machst.
Kannst du mir mal sagen ob ich meinen code auch so lassen kann oder ob deiner anders bzw. schneller ist..
Hier mein code:
Sub daten_eintragen()
Dim arr()
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
'hier Code zum einfügen daten in tabelle
anzwerte_in_datenbank = obj_datenbank.Worksheets("daten" & Version).Cells(obj_datenbank.Worksheets("daten" & Version).Rows.Count, 1).End(xlUp).Row
For z = 2 To anzwerte_in_datenbank
For zz = 0 To UBound(werte, 2)
If UCase$(obj_datenbank.Worksheets("daten" & Version).Cells(z, 1).Value) = UCase$(werte(0, zz)) Then 'zum prüfen
If werte(0, zz) "" Then
i = 0
For s = A_s To A_e
w = s - 100
ReDim Preserve arr(i)
arr(i) = werte(w, zz)
i = i + 1
Next
obj_datenbank.Worksheets("daten" & Version).Range(Cells(z, A_s), Cells(z, A_e)) = arr
Erase arr
i = 0
For s = U_s To U_e
w = s - 102
ReDim Preserve arr(i)
arr(i) = werte(w, zz)
i = i + 1
'obj_datenbank.Worksheets("daten" & Version).Cells(z, s).Value = werte(w, zz)
Next
obj_datenbank.Worksheets("daten" & Version).Range(Cells(z, U_s), Cells(z, U_e)) = arr
Erase arr
i = 0
Exit For
End If
End If
Next zz
Next z
On Error GoTo 0
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Danke.Du bist er beste

Anzeige
AW: Code beschleunigen
21.02.2008 14:44:45
Rudi
Hallo,
sorry, damit kann ich nicht anfangen, da ich den Zusammenhang und deine Absichten nicht kenne.
Gruß
Rudi
Eine Kuh macht Muh, viele Kühe machen Mühe

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige