AW: Bereich selektieren
21.08.2008 18:47:00
Erich
Hi Dirk,
der UsedRange ist manchmal größer als aktuell nötig - z. B. wg. vorangegangener Löschungen.
Die folgenden Funktionen bestimmen den Bereich von der ersten und der letzten Zelle mit einem Wert > "".
Formatierungen (z. B. Farben) werden - im Gegensatz zu UsedRange - nicht berücksichtigt.
Bei dieser Tabelle ergeben sich:
NichtLeererBereich: C6:E8
UsedRange: B5:F9 (mindestens)
Und hier der Code:
Option Explicit
Sub test()
MsgBox NichtLeererBereich().Address
MsgBox "UsedRange: " & ActiveSheet.UsedRange.Address
End Sub
Function NichtLeererBereich(Optional ByVal rngB As Range) As Range
If rngB Is Nothing Then Set rngB = Cells
Set NichtLeererBereich = Range( _
Cells(ErsteZeileInBereich(rngB), ErsteSpalteInBereich(rngB)), _
Cells(LetzteZeileInBereich(rngB), LetzteSpalteInBereich(rngB)))
End Function
Function ErsteZeileInBereich(rngB As Range) As Long
Dim rng As Range
Set rng = rngB.Find("*", rngB.Cells(rngB.Row + rngB.Rows.Count - 1, _
rngB.Column + rngB.Columns.Count - 1), xlValues, , xlByRows, xlNext)
If rng Is Nothing Then
ErsteZeileInBereich = rngB.Cells(1, 1).Row
Else
ErsteZeileInBereich = rng.Row
End If
End Function
Function ErsteSpalteInBereich(rngB As Range) As Long
Dim rng As Range
Set rng = rngB.Find("*", rngB.Cells(rngB.Row + rngB.Rows.Count - 1, _
rngB.Column + rngB.Columns.Count - 1), xlValues, , xlByRows, xlNext)
If rng Is Nothing Then
ErsteSpalteInBereich = rngB.Cells(1, 1).Column
Else
ErsteSpalteInBereich = rng.Column
End If
End Function
Function LetzteZeileInBereich(rngB As Range) As Long
Dim rng As Range
Set rng = rngB.Find("*", rngB.Cells(1, 1), xlValues, , xlByRows, xlPrevious)
If rng Is Nothing Then
LetzteZeileInBereich = rngB.Cells(1, 1).Row
Else
LetzteZeileInBereich = rng.Row
End If
End Function
Function LetzteSpalteInBereich(rngB As Range) As Long
Dim rng As Range
Set rng = rngB.Find("*", rngB.Cells(1, 1), xlValues, , xlByColumns, xlPrevious)
If rng Is Nothing Then
LetzteSpalteInBereich = rngB.Cells(1, 1).Column
Else
LetzteSpalteInBereich = rng.Column
End If
End Function
Wenn alle Zellen erfasst werden sollen, in denen Formeln stehen,
kann man xlValues durch xlFormulas ersetzen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
