ab der aktive Zelle möchte ich nach unten gesehen erstmal zu nächste nichtleere Zelle spingen,
dann ab diese Zelle bis nächste leere Zelle (minus 1) die Zellen markieren.
Wie mache ich das bitte per VBA?
Gruß,
Selma
B | |
2 | |
3 | |
4 | |
5 | x |
6 | x |
7 | |
8 | |
9 | |
10 | x |
11 | |
12 | |
13 | x |
14 | x |
15 | x |
16 |
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...