Supportnet / Forum / Tabellenkalkulation
IF..Then Bedingung in Makro perfomanter machen
Frage
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
Antwort 1 von Saarbauer
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
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
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
@ 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
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
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
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