Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1320to1324
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Funktion mit Laufzeitfehler 13 - Typen unverträgl.

Funktion mit Laufzeitfehler 13 - Typen unverträgl.
08.07.2013 17:17:37
Peter
Guten Tag
Bei meiner Funktion erhalte ich eine Fehlermeldung (Laufzeitfehler '13' - Typen unverträglich). Wenn ich Sie jedoch Schritt für Schritt ablaufen lasse, erhalte ich keinen Fehler - bis zur Rückgabe. Was ist da nicht korrekt.
Im Weiteren habe ich festgestellt, dass ausgeblendete Zeilen oder Spalten mit Inhalt nicht berücksichtigt werden.
Kann das geändert werden?
Gruss, Peter
Function RngActualUsedRange(strWS As String) As Range
Dim FirstCell As Range, LastCell As Range, wsTab As Worksheet
Set wsTab = Sheets(strWS)
Set LastCell = wsTab.Cells(wsTab.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
wsTab.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
Set FirstCell = wsTab.Cells(wsTab.Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows,  _
_
SearchDirection:=xlNext, LookIn:=xlValues).Row, _
wsTab.Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, LookIn:=xlValues).Column)
Set RngActualUsedRange = wsTab.Range(FirstCell, LastCell)
End Function

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Rückfragen
08.07.2013 18:26:25
Erich
Hi Peter,
in welcher Zeile tritt der Fehler auf?
Wie rufst du die Fkt. auf?
Was tust du mit dem Ergebnis?
Was meinst du mit "bis zur Rückgabe"?
Kommt dann der Fehler, auch bei normaler Ausführung, also auch bei 'nicht-schrittweise'?
Fehler 13 erhalte ich z. B. mit
MsgBox RngActualUsedRange("Tabelle2")
Dagegen läuft
MsgBox RngActualUsedRange("Tabelle2").Address
locker durch.
Die Fkt. gibt ein Range zurück, das lässt sich so nicht in der MsgBox anzeigen.
Aber das Range hat eine Adresse, die man anzeigen lassen kann.
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Rückfragen
08.07.2013 21:36:50
Peter
Hallo Erich
"kein Fehler bis zur Rückgabe": ich setze auf der Zeile
<pre>Function RngActualUsedRange(strWS As String) As Range
eine Haltemarke und rufe die Funktion im Direktbereich auf.
Anschliessend kann ich mit F8 die einzelnen Zeilen durchlaufen, bis End Function , dann müsste mir die Funktion den gesuchten Wert zurückliefern ("Rückgabe").
Der Hinweis, dass der Range mit einer MsgBox nicht ausgegeben werden kann, wird sich auch auf die Ausgabe im Direktbereich beziehen. Damit ist die erste Frage geklärt.
Die zweite Frage bleibt noch: kann ich erreichen, dass die Funktion auch ausgeblendete Zeilen / Spalten miteinbezieht?
Wenn dies der Fall ist und die MsgBox RngActualUsedRange("Tabelle2").Address nichts zurück gibt, wäre das dann zurückzuführen, dass der abgefragten Tabelle kein Eintrag besteht (da werde ich dann mit einer Fehlerroutine "A1" (erste Zelle) zurückgebeben.
Vielen Dank und Gruss
Peter

Anzeige
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

Anzeige
UsedRange mit ausgeblendeten Zellen - neue Version
09.07.2013 11:57:10
Erich
Hi Peter,
das konnte man noch ein wenig vereinfachen:

' Variante 3
Sub aTest3()
MsgBox UsedRngHid(Sheets(3)).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
With ws.UsedRange
If .Count = 1 Then Set UsedRngHid = .Cells:     Exit Function
arr = .Value
For zq = 1 To UBound(arr)
For cq = 1 To UBound(arr, 2)
If arr(zq, cq)  "" Then zv = zq + .Row - 1: Exit For
Next cq
If zv 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 + .Row - 1: Exit For
Next cq
If zb 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 + .Column - 1: Exit For
Next zq
If cv 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 + .Column - 1: Exit For
Next zq
If cb Then Exit For
Next cq
End With
Set UsedRngHid = ws.Cells(zv, cv).Resize(zb - zv + 1, cb - cv + 1)
End Function
' Variante 4
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
With ws.UsedRange
If .Cells.Count = 1 Then FirstRowH = .Row:   Exit Function
arr = .Value
For zq = 1 To UBound(arr)
For cq = 1 To UBound(arr, 2)
If arr(zq, cq)  "" Then
FirstRowH = zq + .Row - 1:    Exit Function
End If
Next cq
Next zq
End With
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
With ws.UsedRange
If .Cells.Count = 1 Then FirstColH = .Column:    Exit Function
arr = .Value
For cq = 1 To UBound(arr, 2)
For zq = 1 To UBound(arr)
If arr(zq, cq)  "" Then
FirstColH = cq + .Column - 1:    Exit Function
End If
Next zq
Next cq
End With
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
With ws.UsedRange
If .Cells.Count = 1 Then LastRowH = .Row:    Exit Function
arr = .Value
For zq = UBound(arr) To 1 Step -1
For cq = UBound(arr, 2) To 1 Step -1
If arr(zq, cq)  "" Then
LastRowH = zq + .Row - 1:     Exit Function
End If
Next cq
Next zq
End With
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
With ws.UsedRange
If .Cells.Count = 1 Then LastColH = .Column:    Exit Function
arr = .Value
For cq = UBound(arr, 2) To 1 Step -1
For zq = UBound(arr) To 1 Step -1
If arr(zq, cq)  "" Then
LastColH = cq + .Column - 1:     Exit Function
End If
Next zq
Next cq
End With
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: UsedRange mit ausgeblendeten Zellen - neue Version
09.07.2013 22:21:30
Peter
Hallo Erich
Vielen Dank für die Hinweise und den Code.
Die ersten Tests waren prima. Will mich aber noch etwas da hinein arbeiten.
Ich habe auch entdeckt, dass die Tests im Direktbereich nicht immer zielführend sind, da bei Codes Fehler ausgegeben werden, die anders ausgetestet keine Fehler sind.
z.B. kann kriege ich bei der Eingabe der Zeilen
MsgBox UsedRngHid(Sheets(3)).Address
MsgBox Application.Sum(UsedRngHid(Sheets("Tabelle2")))
keine MsgBox
wohl aber bei MsgBox "AAA"
Danke und Gruss, Peter

146 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige