Autor: Uwe Küstner --- Aus Excel VBA - Gruppe:
Häufige FragenNichtleere Zellen erfassen
Autor: Uwe Küstner - Erstellt: -- - Letzte Revision: --
Häufig steht man vor der Aufgabe, Zellen zu erfassen, die
nicht leer sind.
Es gibt zwar dafür die
SpecialCells-Methode, aber da muss man sich entscheiden,
ob man Zellen mit Werten oder Zellen mit Formeln will.
Eine direkte Umkehr von
.SpecialCells(xlCellTypeBlanks), welche alle leeren Zellen erfasst, gibt es leider nicht.
Mit folgender Funktion ist es jedoch möglich:
Option Explicit
Option Private Module
'Diese Funktion ist nur in VBA anwendbar.
'Option Private Module macht diese Funktion
'im Formelassistenten (unter Benutzerdefiniert)
'unsichtbar
Public Function NoBlanks(Optional rB As Variant) As Range
Dim rngWerte As Range
Dim rngFormeln As Range
Dim rngNichtLeer As Range
If IsMissing(rB) Then
If TypeName(ActiveSheet) = "Worksheet" Then Set rB = ActiveSheet.Cells
End If
On Error Resume Next
If TypeName(rB) <> "Range" Then Exit Function
'Zellen mit Werten
Set rngWerte = rB.Parent.Cells.SpecialCells(xlCellTypeConstants)
'Zellen mit Formeln
Set rngFormeln = rB.Parent.Cells.SpecialCells(xlCellTypeFormulas)
If Not rngWerte Is Nothing Then Set rngNichtLeer = rngWerte
If Not rngFormeln Is Nothing Then
If rngNichtLeer Is Nothing Then
Set rngNichtLeer = rngFormeln
Else
Set rngNichtLeer = Application.Union(rngNichtLeer, rngFormeln)
End If
End If
If Not rngNichtLeer Is Nothing Then Set NoBlanks = _
Application.Intersect(rB, rngNichtLeer)
End Function
Sub Test_NoBlanks()
Dim rng As Range
'Set rng = NoBlanks() 'aktives Blatt alle Zellen
'Set rng = NoBlanks(Sheets("Tabelle2").Cells) 'angegebenes Blatt alle Zellen
'Set rng = NoBlanks(Range("B2:F5")) 'aktives Blatt angegebener Bereich
'angegebenes Blatt angegebener Bereich:
Set rng = NoBlanks(Sheets("Tabelle2").Range("B2:F5"))
If Not rng Is Nothing Then
'Alle Nichtleeren Zellen des Bereiches = roter Hintergrund
rng.Interior.ColorIndex = 3
End If
End Sub
Weitere Artikel der Gruppe: Häufige Fragen Aus Excel VBA
Nach oben