Nächster nichtleerer Bereich einer Spalte
14.12.2013 19:43:47
Erich
Hi Selma,
hier mal zwei Varianten. Die erste arbeitet mit "End(xlDown)", die zweite mit Matthias' Ansatz,
also SpecialCells(xlCellTypeConstants, 23).
Beide geben hier die Adresse eines Bereichs oder eine Fehlermeldung als String zurück.
Kannst/willst du mit der Adresse weiter arbeiten oder sollen die Fkt. den Bereich als Range zurückgeben?
Bei "Range" ist dann die Frage: Was soll im Fehlerfall zurückgegeben werden?
Probier mal
Option Explicit
Sub aTest()
Dim zz As Long
For zz = 3 To 17
Cells(zz, 2) = NxtFulAdr(Cells(zz, 1))
Cells(zz, 3) = NextFullAdr(Cells(zz, 1))
Next zz
For zz = ActiveSheet.Rows.Count - 5 To ActiveSheet.Rows.Count
Cells(zz, 2) = NxtFulAdr(Cells(zz, 1))
Cells(zz, 3) = NextFullAdr(Cells(zz, 1))
Next zz
End Sub
Function NextFullAdr(RngC As Range) As String
Dim rngA As Range, lngM As Long
lngM = RngC.Parent.Rows.Count
If RngC.Row = lngM Then
NextFullAdr = "undefiniert (Spaltenende 0)"
Else
If Not (IsEmpty(RngC) Or IsEmpty(RngC.Offset(1))) Then
Set rngA = RngC.End(xlDown).End(xlDown)
Else
Set rngA = RngC.End(xlDown)
End If
If rngA.Row = lngM Then
If IsEmpty(rngA) Then
NextFullAdr = "undefiniert (Spaltenende 1)"
Else
If IsEmpty(rngA.Offset(-1)) Then
NextFullAdr = rngA.Address(0, 0)
Else
NextFullAdr = "undefiniert (Spaltenende 2)"
End If
End If
Else
If IsEmpty(rngA.Offset(1)) Then
NextFullAdr = rngA.Address(0, 0)
Else
NextFullAdr = Range(rngA, rngA.End(xlDown)).Address(0, 0)
End If
End If
End If
End Function
Function NxtFulAdr(RngC As Range) As String ' nach Matthias L
Dim rngA As Range, lngM As Long
lngM = RngC.Parent.Rows.Count
If RngC.Row = lngM Then
NxtFulAdr = "undefiniert (Spaltenende 0)"
Else
On Error Resume Next
Set rngA = Range(RngC, Cells(Rows.Count, RngC.Column)) _
.SpecialCells(xlCellTypeConstants, 23)
On Error GoTo 0
If rngA Is Nothing Then
NxtFulAdr = "undefiniert (Spaltenende 1)"
Else
If Intersect(RngC, rngA(1)) Is Nothing Then
NxtFulAdr = rngA.Areas(1).Address(0, 0)
Else
If rngA.Areas.Count > 1 Then
NxtFulAdr = rngA.Areas(2).Address(0, 0)
Else
NxtFulAdr = "undefiniert (Spaltenende 2)"
End If
End If
End If
End If
End Function
Und hier die BeiSpielMappe, bei der auch die alleruntersten Zeilen interessant sind...
https://www.herber.de/bbs/user/88518.xlsm
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich