Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1876to1880
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1876to1880
1876to1880
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code Optimierung

Code Optimierung
08.04.2022 22:03:04
Thomas
Hallo,
ich habe in einem Userform einen speicher Button der dann einige Daten in ein Tabellenblatt schreibt, um das zu beschleunigen habe ich vor dem schreiben ein Application.Screenupdating=False, aber trotzdem dauert das Speichern noch gefühlt sehr lange, ins Tabelleblatt wird wie folgt geschreieben

ErsteFreieZeile = Sheets("Tabelle").Range("A65536").End(xlUp).Row + 1
On Error Resume Next
Sheets("Tabelle").Cells(ErsteFreieZeile, 1).Value = txt1.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 2).Value = txt2.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 3).Value = txt3.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 4).Value = CDec(txtPauschal.Value)
Sheets("Tabelle").Cells(ErsteFreieZeile, 5).Value = False
usw.................
das ganze für 80 Spalten, kann ich das optimiern und wenn ja wie?
Danke
MFG

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Optimierung
08.04.2022 22:13:11
onur
1) Bestimmt nicht, ohne die Datei oder ohne zu wissen, was im Code statt usw usw stehen würde.
2) Das solte trotzdem nur Milisekunden dauernd, 80 Spalten sind nix, wofür Excel länger brauchen würde, ausser im "usw usw" sind noch irgend welche "Bremsen" eingebaut.
AW: Code Optimierung
09.04.2022 06:34:18
Thomas
Hallo Onur,
ok du hast wahrscheinlich recht.
Hier der Gesamte Block, ich bin mir recht sicher das das der grund der Verzögerung ist, wenn ich den Block auskommentiere, ist das Speichern direkt erledigt, wenn ich in nicht auskommentiere, dann dauert es ca. 45 Sekunden.

ErsteFreieZeile = Sheets("Tabelle").Range("A65536").End(xlUp).Row + 1
On Error Resume Next
Sheets("Tabelle").Cells(ErsteFreieZeile, 1).Value = txt1.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 2).Value = txt2.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 3).Value = txt3.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 4).Value = CDec(txtPauschal.Value)
Sheets("Tabelle").Cells(ErsteFreieZeile, 5).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 6).Value = txtVereinbarung.Value
'Sheets("Tabelle").Cells(ErsteFreieZeile, 7).Value = CDec(txtVereinbarung1.Value)'Nicht mehr benötigt
'Sheets("Tabelle").Cells(ErsteFreieZeile, 8).Value = False Wurde entfernt da nicht mehr benötigt
Sheets("Tabelle").Cells(ErsteFreieZeile, 9).Value = CDec(txtSchal.Value)
Sheets("Tabelle").Cells(ErsteFreieZeile, 10).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 11).Value = CInt(txtAktion)
Sheets("Tabelle").Cells(ErsteFreieZeile, 12).Value = CDec(txtAktion1)
Sheets("Tabelle").Cells(ErsteFreieZeile, 13).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 14).Value = CInt(txtAktion2)
Sheets("Tabelle").Cells(ErsteFreieZeile, 15).Value = CDec(txtAktion3)
Sheets("Tabelle").Cells(ErsteFreieZeile, 16).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 17).Value = CInt(txtAktion4)
Sheets("Tabelle").Cells(ErsteFreieZeile, 18).Value = CDec(txtAktion5)
Sheets("Tabelle").Cells(ErsteFreieZeile, 19).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 20).Value = CInt(Aktion6)
Sheets("Tabelle").Cells(ErsteFreieZeile, 21).Value = CDec(txtAktion7)
Sheets("Tabelle").Cells(ErsteFreieZeile, 22).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 23).Value = CInt(txtPlatzierung)
Sheets("Tabelle").Cells(ErsteFreieZeile, 24).Value = CDec(txtAktion8)
Sheets("Tabelle").Cells(ErsteFreieZeile, 25).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 26).Value = CInt(txtPlatzierung2)
Sheets("Tabelle").Cells(ErsteFreieZeile, 27).Value = CDec(txtAktion9)
Sheets("Tabelle").Cells(ErsteFreieZeile, 28).Value = False
'    Sheets("Tabelle").Cells(ErsteFreieZeile, 29).Value = CDec(txtPro)'Nicht mehr benötigt
Sheets("Tabelle").Cells(ErsteFreieZeile, 30).Value = CByte(AktionSplit(0))
Sheets("Tabelle").Cells(ErsteFreieZeile, 31).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 32).Value = CInt(AktionSplit(1))
Sheets("Tabelle").Cells(ErsteFreieZeile, 33).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 34).Value = CInt(AktionSplit(2))
Sheets("Tabelle").Cells(ErsteFreieZeile, 35).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 36).Value = CInt(AktionSplit(3))
Sheets("Tabelle").Cells(ErsteFreieZeile, 37).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 38).Value = CInt(AktionSplit(4))
Sheets("Tabelle").Cells(ErsteFreieZeile, 39).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 40).Value = CInt(AktionSplit(5))
Sheets("Tabelle").Cells(ErsteFreieZeile, 41).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 42).Value = CByte(AktionSplit(6))
Sheets("Tabelle").Cells(ErsteFreieZeile, 43).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 44).Value = CInt(AktionSplit(7))
Sheets("Tabelle").Cells(ErsteFreieZeile, 45).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 46).Value = CInt(AktionSplit(8))
Sheets("Tabelle").Cells(ErsteFreieZeile, 47).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 48).Value = CInt(AktionSplit(9))
Sheets("Tabelle").Cells(ErsteFreieZeile, 49).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 50).Value = CInt(AktionSplit(10))
Sheets("Tabelle").Cells(ErsteFreieZeile, 51).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 52).Value = CInt(AktionSplit(11))
Sheets("Tabelle").Cells(ErsteFreieZeile, 53).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 54).Value = CInt(AktionSplit(12))
Sheets("Tabelle").Cells(ErsteFreieZeile, 55).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 56).Value = CInt(AktionSplit(13))
Sheets("Tabelle").Cells(ErsteFreieZeile, 57).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 58).Value = CInt(AktionSplit(14))
Sheets("Tabelle").Cells(ErsteFreieZeile, 59).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 60).Value = CInt(Aktion1Split(0))
Sheets("Tabelle").Cells(ErsteFreieZeile, 61).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 62).Value = CInt(Aktion2Split(1))
Sheets("Tabelle").Cells(ErsteFreieZeile, 63).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 64).Value = CInt(Aktion3Split(2))
Sheets("Tabelle").Cells(ErsteFreieZeile, 65).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 66).Value = CDec(txtList)
Sheets("Tabelle").Cells(ErsteFreieZeile, 67).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 68).Value = txtListe1
Sheets("Tabelle").Cells(ErsteFreieZeile, 69).Value = txtBemerkungen
Sheets("Tabelle").Cells(ErsteFreieZeile, 70).Value = txtMind & " " & cmbEinheit.Value
Sheets("Tabelle").Cells(ErsteFreieZeile, 71).Value = CDec(txtVerguetung)
Sheets("Tabelle").Cells(ErsteFreieZeile, 72).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 73).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 74).Value = txtDatum & " " & Time
Sheets("Tabelle").Cells(ErsteFreieZeile, 75).Value = ""
Sheets("Tabelle").Cells(ErsteFreieZeile, 76).Value = txtSonderTabelle
Sheets("Tabelle").Cells(ErsteFreieZeile, 77).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 78).Value = False
Sheets("Tabelle").Cells(ErsteFreieZeile, 79).Value = ""
On Error GoTo 0

Anzeige
AW: Code Optimierung
09.04.2022 06:56:47
onur
Das ist weder der gesamte Code noch die Datei.
AW: Code Optimierung
08.04.2022 22:17:02
ralf_b
Hier zwei Makros, die du zu Beginn bzw. am Ende deines Makros aufrufen könntest. 

Sub GoodStart() ' Macro Standard Start Block
On Error Resume Next
Application.ScreenUpdating = False
Application.StatusBar = "Working on it..."
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.EnableCancelKey = xlDisabled
On Error GoTo 0
End Sub
Sub GoodEnd() ' Macro Standard End Block
On Error Resume Next
Application.Calculation = xlCalculationAutomatic
Application.EnableCancelKey = xlInterrupt
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error GoTo 0
End Sub

Anzeige
AW: Code Optimierung
11.04.2022 05:40:00
Thomas
Vielen Dank für den Tip, mit diesem und dem weg über ein array zu gehen den @Daniel gegeben hat, konnte die Speicherzeit von über 18 Sekunden auf ca. 4 Sekunden reduziert werden, vielen Dank
AW: Code Optimierung
09.04.2022 00:04:56
Yal
Moin Thomas,
folgende "Vorschlag" wird dein Code nicht schneller machen, da musst eher die Ratschläge von Ralf folgen, aber dafür dein Code kürzer.
Jedes Element ("Control") in einem Userforma kann eine Zusatzinformation in dem Property "tag" bekommen. Du kannst die Controls, die gespeichert werden sollen mit Tag "sp1", "sp2", usw. belegen. "sp" für speichern, der Zahl für die Ziel-Spalte in der Tabelle.
Dann sehen deine 80 Speicherbefehle so aus:

Private Sub CommandSpeichern_Click()
Dim C As String
Dim EFZ As Long
On Error Resume Next
With Sheets("Tabelle")
EFZ = .Range("A65536").End(xlUp).Row + 1
For Each C In Me.Controls
If LCase(Left(C.Tag, 2)) = "sp" Then .Cells(EFZ, CLng(Mid(C.Tag, 3))).Value = C.Value
Next
End With
End Sub
VG
Yal
Anzeige
AW: Code Optimierung
09.04.2022 06:47:07
Thomas
Hallo Yal,
danke für deinen "Vorschlag" das werd ich mir mal genauer ansehen, das würde das ganze ja deutlich verkürzen. Da mir die Property Tags aber noch nicht wirklich was sagen muss ich mir das erstmal in ruhe ansehen.
Tag-Eigenschaft
09.04.2022 13:03:05
{Boris}
Hi,

Da mir die Property Tags aber noch nicht wirklich was sagen
Es sind nicht die "Property Tags", sondern Tag (englisch für Etikett / Anhänger) ist eine einzelne Eigenschaft (=Property) der Steuerelemente. Und diese Eigenschaft kann man sich halt so zu Nutze machen, wie von Yal vorgeschlagen.
Entweder direkt fest in den Eigenschaften verdrahten oder auch per Code zuweisen - z.B.:
Me.CommandButton1.Tag = "sp2"
VG, Boris
Anzeige
Was such möglich ist ...
09.04.2022 19:20:40
Yal
... ist diese automatisch vergebene Nummer an den Namen zu ersetzen:
TextBox1 wird TextBox01
Immer schön 2-stelling, um
Right (controls(i).Name, 2)
Verwenden zu können.
Ist eine Nummer nicht vorhanden, "False" übertragen.
Die CInt, CDec,CByte Konversion müsste man auch eincodieren.
VG
Yal
AW: Was noch möglich ist ...
09.04.2022 19:23:11
Yal
... ist alles genau nachlesen, bevor man postet, um diese blöde Smartphone-Autokorrektur zu korrigieren. :-(
AW: Tag-Eigenschaft
11.04.2022 05:49:18
Thomas
Danke für die Aufklärung, eigentlich logisch :-)
Das macht den Code dann natürlich um einiges kürzer, das kann ich glaub ich noch an anderen stellen sehr gut gebrauchen.
Anzeige
AW: Code Optimierung
09.04.2022 03:15:40
Daniel
Hi
Das Beschreiben von Zellen löst in Excel eine Reihe von Hintergrundprozessen aus, die viel Zeit kosten.
Einen Teil dieser Hintergrundprozesse kann man ausschalten, aber nicht alle.
Daher ist es sinnvoller, alle Zellen gleichzeitig zu beschreiben, weil dann diese Prozesse nur einmal ausgeführt werden und nicht achtzig mal.

Dim arr(1 to 1, 1 to 80)
arr(1, 1) = txt1.Value
arr(1, 2) = txt2.value
arr(1, 80) = ...
Sheets("Tabelle").Cells(ErsteFreieZeile, 1).Resize(1, 80).Value = arr
Gruß Daniel
YES OF COURSE !!!
09.04.2022 06:06:52
Oberschlumpf
Hey Daniel,
DAS is mal ne Idee!
Gefällt mir sehr + hab ich gleich als Favorit gesichert!
Ciao
Thorsten
Anzeige
AW: Code Optimierung
09.04.2022 09:41:44
GerdL
Moin

Dim V(1 To 1, 1 To 78) As Variant
V(1, 1) = txt1
V(1, 2) = txt2
V(1, 3) = txt3
V(1, 4) = CDec(txtPauschal)
V(1, 5) = False
V(1, 6) = txtVereinbarung
V(1, 7) = ""
V(1, 8) = ""
V(1, 9) = CDec(txtSchal)
V(1, 10) = False
V(1, 11) = CInt(txtAktion)
V(1, 12) = CDec(txtAktion1)
V(1, 13) = False
V(1, 14) = CInt(txtAktion2)
V(1, 15) = CDec(txtAktion3)
V(1, 16) = False
V(1, 17) = CInt(txtAktion4)
V(1, 18) = CDec(txtAktion5)
V(1, 19) = False
V(1, 20) = CInt(Aktion6)
V(1, 21) = CDec(txtAktion7)
V(1, 22) = False
V(1, 23) = CInt(txtPlatzierung)
V(1, 24) = CDec(txtAktion8)
V(1, 25) = False
V(1, 26) = CInt(txtPlatzierung2)
V(1, 27) = CDec(txtAktion9)
V(1, 28) = False
V(1, 29) = ""
V(1, 30) = CByte(AktionSplit(0))
V(1, 31) = False
V(1, 32) = CInt(AktionSplit(1))
V(1, 33) = False
V(1, 34) = CInt(AktionSplit(2))
V(1, 35) = False
V(1, 36) = CInt(AktionSplit(3))
V(1, 37) = False
V(1, 38) = CInt(AktionSplit(4))
V(1, 39) = False
V(1, 40) = CInt(AktionSplit(5))
V(1, 41) = False
V(1, 42) = CByte(AktionSplit(6))
V(1, 43) = False
V(1, 44) = CInt(AktionSplit(7))
V(1, 45) = False
V(1, 46) = CInt(AktionSplit(8))
V(1, 47) = False
V(1, 48) = CInt(AktionSplit(9))
V(1, 49) = False
V(1, 50) = CInt(AktionSplit(10))
V(1, 51) = False
V(1, 52) = CInt(AktionSplit(11))
V(1, 53) = False
V(1, 54) = CInt(AktionSplit(12))
V(1, 55) = False
V(1, 56) = CInt(AktionSplit(13))
V(1, 57) = False
V(1, 58) = CInt(AktionSplit(14))
V(1, 59) = False
V(1, 60) = CInt(Aktion1Split(0))
V(1, 61) = False
V(1, 62) = CInt(Aktion2Split(1))
V(1, 63) = False
V(1, 64) = CInt(Aktion3Split(2))
V(1, 65) = False
V(1, 66) = CDec(txtList)
V(1, 67) = False
V(1, 68) = txtListe1
V(1, 69) = txtBemerkungen
V(1, 70) = txtMind & " " & cmbEinheit
V(1, 71) = CDec(txtVerguetung)
V(1, 72) = False
V(1, 73) = False
V(1, 74) = txtDatum & " " & Time
V(1, 75) = ""
V(1, 76) = txtSonderTabelle
V(1, 77) = False
V(1, 78) = False
Sheets("Tabelle").Cells(Sheets("Tabelle").Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, UBound(V, 2)) = V
Gruß Gerd
Anzeige
AW: Code Optimierung
11.04.2022 05:38:49
Thomas
Hallo Daniel,
vielen Dank für diesen Tip, damit läuft der Speichervorrgang deutlich schneller, vorher waren es über 18 Sekunden, nach der anpassung über das array sind es noch ca. 5 Sekunden, ich hab dann auch noch den Tip von @ralf_b umgesetzt und dann sind es sogar nur noch ca. 4 Sekunden. Damit kann man jetzt sehr gut leben.
Vielen Dank
AW: Code Optimierung
11.04.2022 09:13:52
Thomas
Da das super geklappt hat, wollte ich das bei einer anderen Speicherfunktion im Code genauso umsetzen, aber irgendwie bekomme ich das nicht hin, der unterschied ist das der Wert nicht in die erste freie Zeile geschrieben wird, sondern es sich um änderungen handelt wo schon daten in der Tabelle stehen und diese dann aktualisert werden beim Speichern. Nur leider werden die Werte in der jeweiligen Zeile nicht aktualisiert, sondern komplett gelöscht.
Der Ursprungscode der funktionierte, aber sehr langsam war war:

Dim i as long
Dim Wks As Worksheet
Set Wks = Worksheets("Tabelle")
i = libAb.List(libAb.ListIndex, 80)
Wks.Cells(i, 1) = txtAbsprachen
Wks.Cells(i, 2) = txtLi
Wks.Cells(i, 3) = CInt(txtJahr)
usw.
Ich hab das dann so abgeändert, aber wie gesagt dann wird die Zeile komplett gelleert, aber nicht die Daten die sich in den einzelnen Array Elementen befinden reingeschrieben, ich finde meinen Fehler aber nicht.

Dim i As Long
Dim Wks As Worksheet
Dim LastRow As Long
Dim arrSpeichernAbspr() As Variant
Set Wks = Worksheets("Tabelle")
LastRow = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row
ReDim arrSpeichernAbspr(0 To LastRow, 1 To 80)
i = libAb.List(libAb.ListIndex, 80)
arrSpeichernAbspr(i, 1) = txtAbsprachen
arrSpeichernAbspr(i, 2) = txtLi
arrSpeichernAbspr(i, 3) = CInt(txtJahr)
usw.
Wks.Cells(i, 1).Resize(1, 80).Value = arrSpeichernAbspr
Wenn ich mir die einzelnen Array Elemente ansehe, dann bekommen diese alle die korrekten Werte nur das Schreiben im Tabellenblatt klappt nicht.
Danke
Anzeige
AW: Code Optimierung
11.04.2022 17:19:37
ralf_b
naja
GerdL hat dir ein Array vorgegeben
Dim V(1 To 1, 1 To 78) As Varian
wie groß ist denn dein Array? Für nur eine Zeile benötigst du kein Array das alle Zeilen beinhaltet.
ReDim arrSpeichernAbspr(0 To LastRow, 1 To 80)
AW: Code Optimierung
12.04.2022 06:02:13
Thomas
Hi, ja das array von GerdL hatte ich neben dem Vorschlag von Daniel auch als grundlage benutzt, was mich geritten hat das array über die Gesamte größe bilden zu wollen ist mir grad auch nicht klar. Dank deines Hinweises hab ich es nun so angepasst und es sieht so aus als ob alles so klappte wie es soll.
Danke

Dim arrSpeichernAbspr(1 To 1, 1 To 80) As Variant
i = libAb.List(libAbn.ListIndex, 80)
On Error Resume Next
arrSpeichernAbspr(1, 1) = txtAbsprachen
arrSpeichernAbspr(1, 2) = txtLie
arrSpeichernAbspr(1, 3) = CInt(txtJahr)
Wks.Cells(i, 1).Resize(1, 80).Value = arrSpeichernAbspr

Anzeige

Links zu Excel-Dialogen

CommandButton TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige