Supportnet Computer
Planet of Tech

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

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

Antwort 3 von conny77

Die if-Abfragen in deinem Code sind extrem redundant.

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?

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

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

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: