Da ich mit Makros nicht wirklich grosse Erfahrung und Kenntnisse habe, hoffe ich dass jemand von euch mir helfen kann.
Ich sollte für meine Auswertungen folgendes Makro erstellen können: im markierten Bereich (dieser ist je nach Tabelle anders) sollen in jeder markierten Spalte der 1. Wert (dieser steht an unterschiedlichen Stellen) bestehen bleiben und alle weiteren untenstehende Werte in der Spalte gelöscht werden.
Wie müsste ich dieses Makro programmieren? Kann mir hier jemand helfen?
Sorry zusammen, da habe ich wohl zu wenig präzise Infos geliefert.
Mein Problem anhand des beigefügten Attachment:
ich möchte den Bereich B2:CL36 selektieren/markieren. in diesem selektierten Bereich B2 - CL36 soll das Makro in jeder Spalte (also B-CL) den 1. Wert von oben her stehenlassen und alle weiteren untenstehende Werte löschen. Beispiel Spalte B: Wert/Zahl (es sind immer Zahlen) im Feld B12 soll bestehen bleiben, B13 + B14 sollen gelöscht werden. Auch wenn wie in Spalte E mehrere Lücken zwischen den Zahlen bestehen, sollen alle Werte unterhalb des 1. Wertes (pro Spalte) gelöscht werden. Das heisst für Spalte E: E2 soll bestehen bleiben, E3 - E36 sollen alle Werte gelöscht werden.
Da ich nun etliche solcher Tabellen mit unterschiedlicher Grösse habe (d.h. der zu bearbeitende Bereich kann auch B2 - X50 sein), würde ich den Bereich wo das Makro arbeiten soll, jeweils von Hand selektieren. In diesem individuell selektierten Bereich soll nun das Makro funktionieren.
08.09.2015, 09:54 (Dieser Beitrag wurde zuletzt bearbeitet: 08.09.2015, 09:58 von RPP63.
Bearbeitungsgrund: Fehler im Makro
)
Hallo! Es ist einfacher, gleich die gewünschten Spalten über die Spaltenköpfe (B, C, ... X) zu markieren. Dann funktioniert dieses Makro, welches Du in ein allgemeines Modul einfügst: Editiert! Muss ich nochmal überarbeiten!
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Sub RestWeg() Dim Spalte As Long, ErsteZahl As Range, Suchbereich As Range Set Suchbereich = Intersect(Selection, ActiveSheet.UsedRange) Application.ScreenUpdating = False With Suchbereich For Spalte = 1 To .Columns.Count If .Cells(2, Spalte) <> "" Then Set ErsteZahl = .Cells(2, Spalte) Else Set ErsteZahl = .Cells(1, Spalte).End(xlDown) End If Range(ErsteZahl.Offset(1, 0), ErsteZahl.Offset(.Rows.Count, 0)).ClearContents Next End With End Sub
Datei im Anhang.
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag. Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
(08.09.2015, 10:03)RPP63 schrieb: So, Fehler beseitigt!
In ein allgemeines Modul:
Code:
Sub RestWeg() Dim Spalte As Long, ErsteZahl As Range, Suchbereich As Range Set Suchbereich = Intersect(Selection, ActiveSheet.UsedRange) Application.ScreenUpdating = False With Suchbereich For Spalte = 1 To .Columns.Count If .Cells(2, Spalte) <> "" Then Set ErsteZahl = .Cells(2, Spalte) Else Set ErsteZahl = .Cells(1, Spalte).End(xlDown) End If Range(ErsteZahl.Offset(1, 0), ErsteZahl.Offset(.Rows.Count, 0)).ClearContents Next End With End Sub