Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon Markus76 vom 06.03.2019, 08:10 Options
IF..Then Bedingung in Makro perfomanter machen
Guten Morgen miteinander!
Ich habe eine recht umfangreiche Tabelle mit Daten (ca. 9000 Datensätze), die automatisch über ein Makro befüllt wird (d.h.: die ANzahl der Datensätze ist variabel). Mein Problem besteht darin, dass in dieser Tabelle 25 Betragsfelder (Spalten) sind die nicht alle pro Datensatz gefüllt sind. Jetzt möchte ich die gefüllten Betragsfelder hinter die ID ziehen um die Tabelle übersichtlicher und vergleichbarere zu machen.
mit folgendem Makro bringe ich meinen Rechner aber fast zum ABsturz!
[Tabellenblattauswahl
Sheets("Prognose").Select
' Spalten einfügen
Columns("d:d").Select
Selection.Insert Shift:=xlToRight
' Spalten befüllen mit den Spaltennummern 1-8
' zählschleife
i = 4
Do Until IsEmpty(Cells(i, 3))
If Cells(i, 5) <> "" Then Cells(i, 4) = Cells(i, 5)
If Cells(i, 5) = "" Then Cells(i, 4) = Cells(i, 6)
If Cells(i, 5) = "" And Cells(i, 6) = "" Then Cells(i, 4) = Cells(i, 7)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" Then Cells(i, 4) = Cells(i, 8)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" Then Cells(i, 4) = Cells(i, 9)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" Then Cells(i, 4) = Cells(i, 10)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" Then Cells(i, 4) = Cells(i, 11)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" Then Cells(i, 4) = Cells(i, 12)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" Then Cells(i, 4) = Cells(i, 13)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" Then Cells(i, 4) = Cells(i, 14)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" Then Cells(i, 4) = Cells(i, 15)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" Then Cells(i, 4) = Cells(i, 16)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" And Cells(i, 16) = "" Then Cells(i, 4) = Cells(i, 17)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" And Cells(i, 16) = "" And Cells(i, 17) = "" Then Cells(i, 4) = Cells(i, 18) Else Cells(i, 4) = ""
i = i + 1
Loop
End Sub]
Gibt es eine Möglichkeit diese Bedingung perfomanter zu gestalten?
Herzlichen Dank schon mal für Eure Mühen!
Markus
Ich habe eine recht umfangreiche Tabelle mit Daten (ca. 9000 Datensätze), die automatisch über ein Makro befüllt wird (d.h.: die ANzahl der Datensätze ist variabel). Mein Problem besteht darin, dass in dieser Tabelle 25 Betragsfelder (Spalten) sind die nicht alle pro Datensatz gefüllt sind. Jetzt möchte ich die gefüllten Betragsfelder hinter die ID ziehen um die Tabelle übersichtlicher und vergleichbarere zu machen.
mit folgendem Makro bringe ich meinen Rechner aber fast zum ABsturz!
[Tabellenblattauswahl
Sheets("Prognose").Select
' Spalten einfügen
Columns("d:d").Select
Selection.Insert Shift:=xlToRight
' Spalten befüllen mit den Spaltennummern 1-8
' zählschleife
i = 4
Do Until IsEmpty(Cells(i, 3))
If Cells(i, 5) <> "" Then Cells(i, 4) = Cells(i, 5)
If Cells(i, 5) = "" Then Cells(i, 4) = Cells(i, 6)
If Cells(i, 5) = "" And Cells(i, 6) = "" Then Cells(i, 4) = Cells(i, 7)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" Then Cells(i, 4) = Cells(i, 8)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" Then Cells(i, 4) = Cells(i, 9)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" Then Cells(i, 4) = Cells(i, 10)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" Then Cells(i, 4) = Cells(i, 11)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" Then Cells(i, 4) = Cells(i, 12)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" Then Cells(i, 4) = Cells(i, 13)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" Then Cells(i, 4) = Cells(i, 14)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" Then Cells(i, 4) = Cells(i, 15)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" Then Cells(i, 4) = Cells(i, 16)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" And Cells(i, 16) = "" Then Cells(i, 4) = Cells(i, 17)
If Cells(i, 5) = "" And Cells(i, 6) = "" And Cells(i, 7) = "" And Cells(i, 8) = "" And Cells(i, 9) = "" And Cells(i, 10) = "" And Cells(i, 11) = "" And Cells(i, 12) = "" And Cells(i, 13) = "" And Cells(i, 14) = "" And Cells(i, 15) = "" And Cells(i, 16) = "" And Cells(i, 17) = "" Then Cells(i, 4) = Cells(i, 18) Else Cells(i, 4) = ""
i = i + 1
Loop
End Sub]
Gibt es eine Möglichkeit diese Bedingung perfomanter zu gestalten?
Herzlichen Dank schon mal für Eure Mühen!
Markus
Antwort 1 von Saarbauer vom 06.03.2019, 08:26 Options
Hallo,
wenn ich es richtig interperetiert habe soll er immer den Wert der gefüllten Zelle nehmen. Da nicht ersichtlich ob mehrere Zellen in einer Zeile gleichzeitig gefüllt sind,was für eine Lösung wichtif wäre, diese Lösung wäre alle Werte zu addieren. >Diese Lösung funktioniert aber nur wenn ein Wert in jeder Zeile steht.
Gruß
Helmut
wenn ich es richtig interperetiert habe soll er immer den Wert der gefüllten Zelle nehmen. Da nicht ersichtlich ob mehrere Zellen in einer Zeile gleichzeitig gefüllt sind,was für eine Lösung wichtif wäre, diese Lösung wäre alle Werte zu addieren. >Diese Lösung funktioniert aber nur wenn ein Wert in jeder Zeile steht.
Gruß
Helmut
Antwort 2 von Markus76 vom 06.03.2019, 09:03 Options
Hallo,
es ist so, das ich eine Tabelle nehme in eine neues Tabellenblatt transponiert kopiere und diese wiederum mehrfach direkt unter die eingefügte Tabelle vervielfätige.
A1 bis AB1
A138 bis AB138 kopieren
A139 bis AB139
A276 bis AB276 etc.
Nur in der "Mustertabelle (A1/138 bis AB1/138)" sind mehrere Zellen einer Zeile befüllt. Ab dem ersten Duplikat nur noch eine Zelle pro Zeile.
Die restlichen Zellen sind leer (.clearcontents)
Reichen diese Angaben oder sollteb sie noch ausführlicher sein? EIne Mustertabelle hochzuladen ist leider nicht möglich, da mein Arbeitgeber da etwas sensibel ist!
Grüsse
Markus
es ist so, das ich eine Tabelle nehme in eine neues Tabellenblatt transponiert kopiere und diese wiederum mehrfach direkt unter die eingefügte Tabelle vervielfätige.
A1 bis AB1
A138 bis AB138 kopieren
A139 bis AB139
A276 bis AB276 etc.
Nur in der "Mustertabelle (A1/138 bis AB1/138)" sind mehrere Zellen einer Zeile befüllt. Ab dem ersten Duplikat nur noch eine Zelle pro Zeile.
Die restlichen Zellen sind leer (.clearcontents)
Reichen diese Angaben oder sollteb sie noch ausführlicher sein? EIne Mustertabelle hochzuladen ist leider nicht möglich, da mein Arbeitgeber da etwas sensibel ist!
Grüsse
Markus
Antwort 3 von conny77 vom 06.03.2019, 09:04 Options
Die if-Abfragen in deinem Code sind extrem redundant.
So *könnte* es gehen (mußt du selber ausprobieren):
hier: 14 Vergleiche, vorher: 92 Vergleiche, eingespart bei 9000 Datensätzen: bis zu 700.000 Vergleiche.
So *könnte* es gehen (mußt du selber ausprobieren):
if Cells(i, 5) <> "" then Cells(i, 4) = Cells(i, 5)
elseIf Cells(i, 6) <> "" then Cells(i, 4) = Cells(i, 6)
elseIf Cells(i, 7) <> "" then Cells(i, 4) = Cells(i, 7)
elseIf Cells(i, 8) <> "" then Cells(i, 4) = Cells(i, 8)
elseIf Cells(i, 9) <> "" then Cells(i, 4) = Cells(i, 9)
elseIf Cells(i, 10) <> "" then Cells(i, 4) = Cells(i, 10)
elseIf Cells(i, 11) <> "" then Cells(i, 4) = Cells(i, 11)
etc.
elseIf Cells(i, 18) <> "" then Cells(i, 4) = Cells(i, 18)
else Cells(i, 4) = ""
end if
hier: 14 Vergleiche, vorher: 92 Vergleiche, eingespart bei 9000 Datensätzen: bis zu 700.000 Vergleiche.
Antwort 4 von Markus76 vom 06.03.2019, 09:12 Options
@ Conny77
Habe Deinen Code kopiert, angepasst und ausprobiert . Es erscheint der Fehler:
Fehler beim kompilieren
else ohne if
Woran kann das liegen?
Habe Deinen Code kopiert, angepasst und ausprobiert . Es erscheint der Fehler:
Fehler beim kompilieren
else ohne if
Woran kann das liegen?
Antwort 5 von nighty vom 06.03.2019, 09:48 Options
hi all:-)
in der ersten zeile ist eine abgeschlossene if then struktur in der zweiten zeile wird dann mit else begonnen was natuerlich nicht logisch ist
gruss nighty
in der ersten zeile ist eine abgeschlossene if then struktur in der zweiten zeile wird dann mit else begonnen was natuerlich nicht logisch ist
gruss nighty
Antwort 6 von nighty vom 06.03.2019, 10:12 Options
hi all :-)
zur geschwindigkeit liesse sich noch sagen die zu vergleichenden daten vorher in ein array zu legen und dann das array in der if abfrage zu vergleichen
gruss nighty
zur geschwindigkeit liesse sich noch sagen die zu vergleichenden daten vorher in ein array zu legen und dann das array in der if abfrage zu vergleichen
gruss nighty
Antwort 7 von Markus76 vom 06.03.2019, 10:13 Options
Hallo!
Mit diesem COde klappt' jetzt:
i = 4
Do Until IsEmpty(Cells(i, 3))
If Cells(i, 5) <> "" And Cells(i, 6) <> "" And Cells(i, 7) <> "" And Cells(i, 8) <> "" And Cells(i, 9) <> "" And Cells(i, 10) <> "" And Cells(i, 11) <> "" And Cells(i, 12) <> "" And Cells(i, 13) <> "" And Cells(i, 14) <> "" And Cells(i, 15) <> "" And Cells(i, 16) <> "" And Cells(i, 17) <> "" And Cells(i, 18) <> "" And Cells(i, 19) <> "" And Cells(i, 20) <> "" And Cells(i, 21) <> "" And Cells(i, 22) <> "" And Cells(i, 23) <> "" And Cells(i, 24) <> "" And Cells(i, 24) <> "" And Cells(i, 25) <> "" And Cells(i, 26) <> "" Then
ElseIf Cells(i, 5) <> "" Then Cells(i, 4) = Cells(i, 5)
ElseIf Cells(i, 6) <> "" Then Cells(i, 4) = Cells(i, 6)
ElseIf Cells(i, 7) <> "" Then Cells(i, 4) = Cells(i, 7)
ElseIf Cells(i, 8) <> "" Then Cells(i, 4) = Cells(i, 8)
ElseIf Cells(i, 9) <> "" Then Cells(i, 4) = Cells(i, 9)
etc.
ElseIf Cells(i, 26) <> "" Then Cells(i, 4) = Cells(i, 26)
End If
i=i+1
end sub
Einziges Problemchen ist jetzt noch, dass die ersten zwei Zellen in denen das Ergebnis erscheinen sollte leerbleiben. Warum????
Trotzdem herzlichen Dank an alle, die bei der Lösung mitgewirkt haben!!
Markus
Mit diesem COde klappt' jetzt:
i = 4
Do Until IsEmpty(Cells(i, 3))
If Cells(i, 5) <> "" And Cells(i, 6) <> "" And Cells(i, 7) <> "" And Cells(i, 8) <> "" And Cells(i, 9) <> "" And Cells(i, 10) <> "" And Cells(i, 11) <> "" And Cells(i, 12) <> "" And Cells(i, 13) <> "" And Cells(i, 14) <> "" And Cells(i, 15) <> "" And Cells(i, 16) <> "" And Cells(i, 17) <> "" And Cells(i, 18) <> "" And Cells(i, 19) <> "" And Cells(i, 20) <> "" And Cells(i, 21) <> "" And Cells(i, 22) <> "" And Cells(i, 23) <> "" And Cells(i, 24) <> "" And Cells(i, 24) <> "" And Cells(i, 25) <> "" And Cells(i, 26) <> "" Then
ElseIf Cells(i, 5) <> "" Then Cells(i, 4) = Cells(i, 5)
ElseIf Cells(i, 6) <> "" Then Cells(i, 4) = Cells(i, 6)
ElseIf Cells(i, 7) <> "" Then Cells(i, 4) = Cells(i, 7)
ElseIf Cells(i, 8) <> "" Then Cells(i, 4) = Cells(i, 8)
ElseIf Cells(i, 9) <> "" Then Cells(i, 4) = Cells(i, 9)
etc.
ElseIf Cells(i, 26) <> "" Then Cells(i, 4) = Cells(i, 26)
End If
i=i+1
end sub
Einziges Problemchen ist jetzt noch, dass die ersten zwei Zellen in denen das Ergebnis erscheinen sollte leerbleiben. Warum????
Trotzdem herzlichen Dank an alle, die bei der Lösung mitgewirkt haben!!
Markus
Ähnliche Themen
wieder Makro Code
achmi71 14.01.2007 - 134 Hits - 9 Antworten
Makro um eine Bedingung erweitern
Flo077 16.03.2007 - 66 Hits -
Summierung durch Makro mit 2 Bedingungen
Peter3011 19.05.2007 - 111 Hits - 12 Antworten
Abhängige Listenfelder
simbi 19.06.2007 - 113 Hits - 8 Antworten
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
