Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Funktion mit Laufzeitfehler 13 - Typen unverträgl.

Betrifft: Funktion mit Laufzeitfehler 13 - Typen unverträgl. von: Peter
Geschrieben am: 08.07.2013 17:17:37

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

  

Betrifft: Rückfragen von: Erich G.
Geschrieben am: 08.07.2013 18:26:25

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


  

Betrifft: AW: Rückfragen von: Peter
Geschrieben am: 08.07.2013 21:36:50

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


  

Betrifft: UsedRange mit ausgeblendeten Zellen von: Erich G.
Geschrieben am: 09.07.2013 10:14:16

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


  

Betrifft: UsedRange mit ausgeblendeten Zellen - neue Version von: Erich G.
Geschrieben am: 09.07.2013 11:57:10

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


  

Betrifft: AW: UsedRange mit ausgeblendeten Zellen - neue Version von: Peter
Geschrieben am: 09.07.2013 22:21:30

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


 

Beiträge aus den Excel-Beispielen zum Thema "Funktion mit Laufzeitfehler 13 - Typen unverträgl."