AW: letzte Zeile in Spalte bei Fixierung
01.05.2014 21:14:01
Hajo_Zi
Hallo, Tino,
hier mal ein Ansartz bei Autfilter oder ausgeblendeten Zeile. Vielleicht hilft es.
Es müsste nur in der neuen Application die Fixierung aufgehoben werden.
' ************************************************************* _
' Modul: mdl_Stefan_Giehrl Typ = Allgemeines Modul
' **************************************************************
Option Explicit _
' Variablendefinition erforderlich
Function LetzteZeile(Pruefspalte As String)
Application.ScreenUpdating = False
ActiveWorkbook.CustomViews.Add ViewName:="Temp" _
span>, PrintSettings:=True, _
RowColSettings:=True
With Cells
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
End With
LetzteZeile = IIf(IsEmpty(Cells(Rows.Count, Pruefspalte)), Cells( _
Rows.Count, Pruefspalte).End(xlUp).Row, Rows.Count)
ActiveWorkbook.CustomViews("Temp"). _
Show
ActiveWorkbook.CustomViews("Temp"). _
Delete
Application.ScreenUpdating = True
End Function
Sub Stefan_Giehrl()
MsgBox "letzte gefüllte Zeile " & _
LetzteZeile("A"), 48, "Stefan Giehrl"
End Sub
' von Stefan Giehrl
' Veränderung letzte Zeile, With Ergänzung Hajo Ziplies
' **************************************************************
' Modul: mdl_Josef_Ehrensberger Typ = Allgemeines Modul
' **************************************************************
Option Explicit ' Variablendefinition erforderlich
Sub Josef_Ehrensberger()
Dim lngFirstFree As Long, lngRealFirstFree As Long
lngFirstFree = Cells(Rows.Count, 1).End(xlUp).Row + 1
lngRealFirstFree = firstEmpty(Range("A:A"))
' noch Prüfung ob Ergebinis Funktion = 0 dann ist keine Zeile mehr frei
' Vergleich Ergänzung Hajo Ziplies
If CStr(lngRealFirstFree) = 0 Then
MsgBox "erste freie Zelle mit .End(xlup) = " & vbTab & CStr(lngFirstFree) & vbLf & _
"mit Funktion es ist keine Zeile mehr frei.", 48, "Josef Ehrensberger"
Else
MsgBox "erste freie Zelle mit .End(xlup) = " & vbTab & CStr(lngFirstFree) & vbLf & _
"erste freie Zelle mit Funktion = " & vbTab & CStr(lngRealFirstFree), 48, "Josef Ehrensberger"
End If
End Sub
Private Function firstEmpty(ByRef RNG As Range, Optional ByVal Row0_Or_Col1 As Integer = 0) As Long
Dim scrUPD As Boolean
On Error Resume Next
scrUPD = Application.ScreenUpdating ' Zustand Bildschirmaktualisierung merken
Application.ScreenUpdating = False
With RNG
.Parent.Parent.CustomViews.Add ViewName:="xyzxyz", _
PrintSettings:=False, RowColSettings:=True
If .Parent.AutoFilterMode Then .Parent.ShowAllData
If Row0_Or_Col1 = 0 Then
firstEmpty = .Find(what:="*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
If firstEmpty > .Parent.Rows.Count Then firstEmpty = 0
Else
firstEmpty = .Find(what:="*", _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column + 1
If firstEmpty > .Parent.Columns.Count Then firstEmpty = 0
End If
With .Parent.Parent.CustomViews("xyzxyz")
.Show
.Delete
End With
End With
Application.ScreenUpdating = scrUPD ' Zustand Bildschirmaktualisierung zurück
End Function
' von Josef Ehrensberger
