AW: Marko anpassen/ verbessern
20.06.2010 10:21:24
fcs
Hallo Lemmi,
dann muss man die letzte mit Daten/Formeln belegte Zeile bzw. Spalte etwas aufwendiger ermitteln.
Außerdem sollten natürlich die Startzeilen in den Makros aufraeumen und aufraeumen_rueckwarts identisch sein.
Gruß
Franz
Sub aufraeumen()
Dim ZeileMax As Long, SpalteMax As Long
Dim Zeile As Long, Spalte As Long
'Zeile der letzten benutzten Zelle
ZeileMax = fncZeileLetzte(wks:=ActiveSheet)
'Spalte der letzten benutzten Zelle
SpalteMax = fncSpalteLetzte(wks:=ActiveSheet, ZeileStart:=6)
For Zeile = 6 To ZeileMax
For Spalte = SpalteMax - 1 To 1 Step -1
If Cells(Zeile, SpalteMax) "" Then Exit For
If Cells(Zeile, Spalte) "" Then
Cells(Zeile, SpalteMax) = Cells(Zeile, Spalte)
Cells(Zeile, Spalte).ClearContents
Exit For
End If
Next
Next
End Sub
Sub aufraeumen_rueckwaerts()
Dim ZeileMax As Long, SpalteMax As Long
Dim Spalte As Long, Zelle As Range
'Zeile der letzten benutzten Zelle
ZeileMax = fncZeileLetzte(wks:=ActiveSheet)
'Spalte der letzten benutzten Zelle
SpalteMax = fncSpalteLetzte(wks:=ActiveSheet, ZeileStart:=6)
For Zeile = 6 To ZeileMax
If IsEmpty(Cells(Zeile, SpalteMax - 1)) Then
Set Zelle = Cells(Zeile, SpalteMax).End(xlToLeft)
If Zelle.Column >= 3 Then
Zelle.Offset(0, 1).Value = Cells(Zeile, SpalteMax).Value
Else
Cells(Zeile, 3).Value = Cells(Zeile, SpalteMax).Value
End If
Cells(Zeile, SpalteMax).ClearContents
End If
Next
End Sub
Function fncZeileLetzte(wks As Worksheet, Optional SpalteStart As Long = 1) As Long
'Ermittelt letzte Zeile mit Daten (Werte/Formeln)
'Bei leerem Blatt wird Wert 0 zurückgegeben!!
Dim Spalte As Long, Zeile As Long
With wks
For Spalte = .Cells.SpecialCells(xlCellTypeLastCell).Column To SpalteStart Step -1
If IsEmpty(.Cells(.Rows.Count, Spalte)) Then
Zeile = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If Zeile > 1 Then
fncZeileLetzte = Application.WorksheetFunction.Max(Zeile, fncZeileLetzte)
Else
If Not IsEmpty(.Cells(1, Spalte)) Then
fncZeileLetzte = Application.WorksheetFunction.Max(Zeile, fncZeileLetzte)
End If
End If
Else
fncZeileLetzte = .Rows.Count
Exit For
End If
Next Spalte
End With
End Function
Function fncSpalteLetzte(wks As Worksheet, Optional ZeileStart As Long = 1) As Long
'Ermittelt letzte Spalte mit Daten (Werte/Formeln)
'Bei leerem Blatt wird Wert 0 zurückgegeben!!
Dim Spalte As Long, Zeile As Long
With wks
For Spalte = .Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
If IsEmpty(.Cells(.Rows.Count, Spalte)) Then
Zeile = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If Zeile >= ZeileStart And Zeile > 1 Then
fncSpalteLetzte = Spalte
Exit For
ElseIf ZeileStart = 1 And Zeile = 1 Then
If Not IsEmpty(.Cells(1, Spalte)) Then
fncSpalteLetzte = Spalte
Exit For
End If
End If
Else
fncSpalteLetzte = Spalte
Exit For
End If
Next Spalte
End With
End Function