letzte gefüllte Zelle ermitteln
25.01.2019 13:26:05
Rudi
Hallo,
jetzt schießen wir mal ein bisschen mit Kanonen auf Spatzen:
Sub test()
Dim x As Long, y As Long
y = LastUsedColumnInRange(ActiveSheet)
x = LastUsedRowInRange(ActiveSheet)
If x = 0 And y = 0 Then
MsgBox "Keine Zellen benutzt!"
Else
MsgBox Cells(x, y).Address
'Application.Goto Cells(x, y), True
End If
End Sub
Function LastUsedRowInRange( _
wks As Worksheet, _
Optional lngFirstRow&, _
Optional lngLastRow&, _
Optional lngFirstColumn&, _
Optional lngLastColumn&) _
As Long
'Letzte Zeile mit Inhalt in einem Bereich
'Parameter
'wks: das Blatt
'lngFirstRow&: die erste Zeile
'lngLastRow&: die letzte Zeile
'lngFirstColumn&: die erste Spalte, A=1, B=2 etc.
'lngLastColumn&; die letzte Spalte
Dim lngTmp&, blnFound As Boolean
'sicherstellen, dass die Parameter gültig sind
If lngFirstRow Rows.Count Then lngFirstRow = 1
If lngLastRow Rows.Count Then lngLastRow = Rows.Count
If lngFirstColumn Columns.Count Then lngFirstColumn = 1
If lngLastColumn Columns.Count Then lngLastColumn = Columns.Count
'drehen falls erster Wert > letzter Wert
If lngFirstRow > lngLastRow Then
lngTmp = lngLastRow
lngLastRow = lngFirstRow
lngFirstRow = lngTmp
End If
If lngFirstColumn > lngLastColumn Then
lngTmp = lngLastColumn
lngLastColumn = lngFirstColumn
lngFirstColumn = lngTmp
End If
'jetzt geht's los
With wks
If Application.CountA(.Range(.Cells(lngLastRow, lngFirstColumn), .Cells(lngLastRow, _
lngLastColumn))) Then
LastUsedRowInRange = lngLastRow: Exit Function
End If
If Application.CountA(.Range(.Cells(lngFirstRow, lngFirstColumn), .Cells(lngLastRow, _
lngLastColumn))) = 0 Then
LastUsedRowInRange = 0: Exit Function
End If
lngTmp = (lngFirstRow + lngLastRow) / 2
If lngLastRow > lngFirstRow + 1 Then
If Application.CountA(.Range(.Cells(lngTmp, lngFirstColumn), .Cells(lngLastRow, _
lngLastColumn))) Then
lngFirstRow = lngTmp
blnFound = True
End If
If Not blnFound And _
Application.CountA(.Range(.Cells(lngFirstRow, lngFirstColumn), .Cells(lngTmp, _
lngLastColumn))) Then
lngLastRow = lngTmp
End If
LastUsedRowInRange wks, lngFirstRow, lngLastRow, lngFirstColumn, lngLastColumn
End If
End With
LastUsedRowInRange = lngFirstRow
End Function
Function LastUsedColumnInRange( _
wks As Worksheet, _
Optional lngFirstRow&, _
Optional lngLastRow&, _
Optional lngFirstColumn&, _
Optional lngLastColumn&) _
As Long
'Letzte Spalte mit Inhalt in einem Bereich
'Parameter
'wks: das Blatt
'lngFirstRow&: die erste Zeile
'lngLastRow&: die letzte Zeile
'lngFirstColumn&: die erste Spalte, A=1, B=2 etc.
'lngLastColumn&; die letzte Spalte
Dim lngTmp&, blnFound As Boolean
'sicherstellen, dass die Parameter gültig sind
If lngFirstRow Rows.Count Then lngFirstRow = 1
If lngLastRow Rows.Count Then lngLastRow = Rows.Count
If lngFirstColumn Columns.Count Then lngFirstColumn = 1
If lngLastColumn Columns.Count Then lngLastColumn = Columns.Count
'drehen falls erster Wert > letzter Wert
If lngFirstRow > lngLastRow Then
lngTmp = lngLastRow
lngLastRow = lngFirstRow
lngFirstRow = lngTmp
End If
If lngFirstColumn > lngLastColumn Then
lngTmp = lngLastColumn
lngLastColumn = lngFirstColumn
lngFirstColumn = lngTmp
End If
'jetzt geht's los
With wks
If Application.CountA(.Range(.Cells(lngFirstRow, lngLastColumn), .Cells(lngLastRow, _
lngLastColumn))) Then
LastUsedColumnInRange = lngLastColumn: Exit Function
End If
If Application.CountA(.Range(.Cells(lngFirstRow, lngFirstColumn), .Cells(lngLastRow, _
lngLastColumn))) = 0 Then
LastUsedColumnInRange = 0: Exit Function
End If
lngTmp = (lngFirstColumn + lngLastColumn) / 2
If lngLastColumn > lngFirstColumn + 1 Then
If Application.CountA(.Range(.Cells(lngFirstRow, lngTmp), .Cells(lngLastRow, _
lngLastColumn))) Then
lngFirstColumn = lngTmp
blnFound = True
End If
If Not blnFound And _
Application.CountA(.Range(.Cells(lngFirstRow, lngFirstColumn), .Cells(lngLastRow, _
lngTmp))) Then
lngLastColumn = lngTmp
End If
LastUsedColumnInRange wks, lngFirstRow, lngLastRow, lngFirstColumn, lngLastColumn
End If
End With
LastUsedColumnInRange = lngFirstColumn
End Function
Gruß
Rudi