hier mein erster Beitrag. Ich stehe vor der Problemstellung eine .xls, die viele nicht notwendige Daten erhält, stark auszudünnen um aus den relevanten Daten schneller Informationen zu erhalten.
Der Datensatz besteht aus 27 Spalten und sehr sehr vielen Zeilen.
Anforderungen an das Skript:
=> Zeilen entfernen aber niemals die 1. Zeile
1. Alle Zeilen mit ColorIndex (Grün) = 43 sollen entfernt werden. Die Farbe grün streckt sich hier immer über den gesamten Spaltebereich innerhalb einer Zeile.
2. Alle Zeilen in denen in Spalte B (2) nichts enthalten ist (außer Zeile 1) oder ein bestimmter Wert bla gesetzt ist, sollen entfernt werden. Bla kann in vielen Zellen innerhalb der Spalte B vorkommen (jedoch nicht in anderen Spalten!). Immer wenn das der Fall ist, soll gleich die gesamte Zeile gelöscht werden.
3. Alle Zeilen, bei denen in Spalte F eine 0 steht, sollen in ein neues zweites Tabellenblatt kopiert werden (inkl. erste Zeile) mit dem Namen NeuesBlatt (wichtig, dass das erst passiert nachdem 1 und 2 abgeschlossen ist), alle restlichen Zeilen sollen in dem Tabellenblatt bestehen bleiben
=> Berechnetes Feld
5. Für alle bestehenden Zeilen bei denen Spalte F NICHT 0 ist, sollen im ersten Tabellenblatt eine weitere Spalte (am Ende) hinzugefügt werden in denn ein berechnetes Feld montiert werden soll. Die Formel ist natürlich abhängig davon, wann der folgende Schritt mit der Spaltenlöschung kommt. Es soll auf jeden Fall fröhlich rumdividiert werden und ein Prozentsatz ausgerechnet werden. Nachdem Schritt 4 auch noch getan ist gilt folgende Formel: =(D3-(F3*-1000/C3))/(F3*-1000/C3) . Das ist ein Beispiel für Zeile3.
=> Spalten entfernen
4. Folgende Spalten sollen gelöscht werden: 4,6, F:L, N:Y, 27
Ich als VBA-Anfänger bin jetzt seit einigen Wochen dran und habe schon unzählige Tutorials durch. Mein Ansatz ist aktuell folgender:
Sub VereinfachungsMakro()
Dim Bereich As Range
Set Bereich = Union(Columns(4), Columns(6), Columns("F:L"), Columns("N:Y"), Columns(27))
Bereich.Delete
Dim rng As Range
For Each rng In ActiveSheet.UsedRange
If rng.Interior.ColorIndex = 43 Then
rng.Delete
End If
Next rng
Dim rng2 As Range
For Each rng2 In ActiveSheet.UsedRange
If rng2.Value = "" Then
rng2.Delete
End If
Next rng2
Dim rng3 As Range
For Each rng3 In ActiveSheet.UsedRange
If rng3.Value = "bla" Then
rng3.Delete
End If
Next rng3
End Sub
Hat hier jemand Verbesserungsvorschläge bzw. kann mir Tipps geben wie ich zum Ergebnis komme? Ich bin sehr darauf versteift das selbst hinzukriegen, aber leider reichen meine Kenntnisse dafür noch nicht aus.Vielen Dank und schöne Grüße
Simon