UsedRange mit ausgeblendeten Zellen
09.07.2013 10:14:16
Erich
Hi Peter,
zuerst noch mal ein Hinweis: "dann müsste mir die Funktion den gesuchten Wert zurückliefern"
stimmt nicht. Die Funktion liefert keinen Wert zurück, sondern ein Range, also ein Bereichsobjekt.
Ein Range hat diverse Eigenschaften (z. B. Font, Address) und Methoden (z. B. Find, Delete).
Eine Range-Methode für "Ausgabe" oder "Anzeigen" oder Ähnliches gibt es i. A. nicht.
Verwenden kann man ein Range auch in Funktionen wie z. B. SUMME, die ein Range verarbeiten können:
Msgbox Application.Sum(UsedRngHid(Sheets("Tabelle2"))
Hier mal zwei Varianten mit ausgeblendeten Zellen:
Option Explicit
' Variante 1
Sub aTest1()
MsgBox UsedRngHid(Sheets(1)).Address
Msgbox Application.Sum(UsedRngHid(Sheets("Tabelle2")))
End Sub
Function UsedRngHid(Optional ws As Worksheet) As Range
Dim arr, zq As Long, cq As Long
Dim zv As Long, cv As Long, zb As Long, cb As Long
If ws Is Nothing Then Set ws = ActiveSheet
arr = ws.UsedRange.Value
If Not IsArray(arr) Then
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = 0
End If
For zq = 1 To UBound(arr)
For cq = 1 To UBound(arr, 2)
If arr(zq, cq) "" Then zv = zq + ws.UsedRange.Row - 1: Exit For
Next cq
If zv > 0 Then Exit For
Next zq
For zq = UBound(arr) To 1 Step -1
For cq = UBound(arr, 2) To 1 Step -1
If arr(zq, cq) "" Then zb = zq + ws.UsedRange.Row - 1: Exit For
Next cq
If zb > 0 Then Exit For
Next zq
For cq = 1 To UBound(arr, 2)
For zq = 1 To UBound(arr)
If arr(zq, cq) "" Then cv = cq + ws.UsedRange.Column - 1: Exit For
Next zq
If cv > 0 Then Exit For
Next cq
For cq = UBound(arr, 2) To 1 Step -1
For zq = UBound(arr) To 1 Step -1
If arr(zq, cq) "" Then cb = cq + ws.UsedRange.Column - 1: Exit For
Next zq
If cb > 0 Then Exit For
Next cq
Set UsedRngHid = ws.Cells(zv, cv).Resize(zb - zv + 1, cb - cv + 1)
End Function
' Variante 2
Sub aTest2()
MsgBox UsedRngAkt(Sheets(2)).Address
End Sub
' Benutzter Bereich(Blatt) - auch hidden
Function UsedRngAkt(Optional ByVal ws As Worksheet) As Range
Dim zv As Long, cv As Long
If ws Is Nothing Then Set ws = ActiveSheet
zv = FirstRowH(ws)
cv = FirstColH(ws)
Set UsedRngAkt = ws.Cells(FirstRowH(ws), cv).Resize( _
LastRowH(ws) - zv + 1, LastColH(ws) - cv + 1)
End Function
' Erste benutzte Zeile(Blatt) - auch hidden
Function FirstRowH(Optional ByVal ws As Worksheet) As Long
Dim arr, zq As Long, cq As Long
If ws Is Nothing Then Set ws = ActiveSheet
arr = ws.UsedRange.Value
If Not IsArray(arr) Then
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = 0
End If
For zq = 1 To UBound(arr)
For cq = 1 To UBound(arr, 2)
If arr(zq, cq) "" Then
FirstRowH = zq + ws.UsedRange.Row - 1: Exit Function
End If
Next cq
Next zq
End Function
' Erste benutzte Spalte(Blatt) - auch hidden
Function FirstColH(Optional ByVal ws As Worksheet) As Long
Dim arr, zq As Long, cq As Long
If ws Is Nothing Then Set ws = ActiveSheet
arr = ws.UsedRange.Value
If Not IsArray(arr) Then
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = 0
End If
For cq = 1 To UBound(arr, 2)
For zq = 1 To UBound(arr)
If arr(zq, cq) "" Then
FirstColH = cq + ws.UsedRange.Column - 1: Exit Function
End If
Next zq
Next cq
End Function
' Letzte benutzte Zeile(Blatt) - auch hidden
Function LastRowH(Optional ByVal ws As Worksheet) As Long
Dim arr, zq As Long, cq As Long
If ws Is Nothing Then Set ws = ActiveSheet
arr = ws.UsedRange.Value
If Not IsArray(arr) Then
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = 0
End If
For zq = UBound(arr) To 1 Step -1
For cq = UBound(arr, 2) To 1 Step -1
If arr(zq, cq) "" Then
LastRowH = zq + ws.UsedRange.Row - 1: Exit Function
End If
Next cq
Next zq
End Function
' Letzte benutzte Spalte(Blatt) - auch hidden
Function LastColH(Optional ByVal ws As Worksheet) As Long
Dim arr, zq As Long, cq As Long
If ws Is Nothing Then Set ws = ActiveSheet
arr = ws.UsedRange.Value
If Not IsArray(arr) Then
ReDim arr(1 To 1, 1 To 1): arr(1, 1) = 0
End If
For cq = UBound(arr, 2) To 1 Step -1
For zq = UBound(arr) To 1 Step -1
If arr(zq, cq) "" Then
LastColH = cq + ws.UsedRange.Column - 1: Exit Function
End If
Next zq
Next cq
End Function
Und noch zwei Links dazu:
https://www.herber.de/forum/archiv/836to840/839053_Suchen_der_letzten_beschriebenen_ausgeblendeten_Sp.html#839095
https://www.herber.de/forum/archiv/932to936/934998_Letzte_Zeile_finden.html
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich