Laufzeitfehler 91
05.10.2021 08:10:02
Stephan
bei meinem Makro bekomme ich einen Fehler, den ich trotz meiner Recherchen nicht ausfindig machen kann.
Das Makro ist noch nicht fertig, jedoch soll es grundsätzlich einmal die gesamte Tabelle nach leeren Zellen durchsuchen. Ist eine leere Zelle gefunden, soll sie einem gewissen Bereich zugeordnet werden. Das Makro durchsucht die Zeilen von links nach rechts. In meiner Testdatei sind die Zellen D2, E2, G2 und H2 leer. Das Makro erkennt und ordnet die ersten drei leeren Zellen dem korrekten Bereich zu, bei der Zelle H2 gibt es Probleme bei der Prüfung, ob sie sich in "Block2" befindet.
Wo liegt mein Fehler? Kann das jemand erkennen?
Sub loesen()
Dim Zelle As Range
Dim Zahl As Byte
Dim Aktive_Zelle As Variant
Dim rAktive_Zelle As Range
Dim Block As Range
Dim Block1 As Range
Dim Block2 As Range
Dim Block3 As Range
Dim Block4 As Range
Dim Block5 As Range
Dim Block6 As Range
Dim Block7 As Range
Dim Block8 As Range
Dim Block9 As Range
Set Block1 = Range("B2:D4")
Set Block2 = Range("E2:G4")
Set Block3 = Range("H2:J4")
Set Block4 = Range("B5:D7")
Set Block5 = Range("E5:G7")
Set Block6 = Range("H5:J7")
Set Block7 = Range("B8:D10")
Set Block8 = Range("E8:G10")
Set Block9 = Range("H8:J10")
For Each Zelle In Range("B2:J10")
If Zelle = "" Then
'Zelle.Select
Aktive_Zelle = Zelle.AddressLocal(columnabsolute = True, rowabsolute = True)
Set rAktive_Zelle = ActiveSheet.Range(Aktive_Zelle & " : " & Aktive_Zelle)
' Block der aktiven Zelle finden
If Not Intersect(rAktive_Zelle, Block1) Is Nothing Then
'MsgBox "Block1"
Set Block = Block1
Else
If Not Intersect(rAktive_Zelle, Block2) Then
'MsgBox "Block2"
Set Block = Block2
Else
If Not Intersect(rAktive_Zelle, Block3) Then
'MsgBox "Block3"
Set Block = Block3
Else
If Not Intersect(rAktive_Zelle, Block4) Then
'MsgBox "Block4"
Set Block = Block4
Else
If Not Intersect(rAktive_Zelle, Block5) Then
'MsgBox "Block5"
Set Block = Block5
Else
If Not Intersect(rAktive_Zelle, Block6) Then
'MsgBox "Block6"
Set Block = Block6
Else
If Not Intersect(rAktive_Zelle, Block7) Then
'MsgBox "Block7"
Set Block = Block7
Else
If Not Intersect(rAktive_Zelle, Block8) Then
'MsgBox "Block8"
Set Block = Block8
Else
If Not Intersect(rAktive_Zelle, Block9) Then
'MsgBox "Block9"
Set Block = Block9
Else
MsgBox "Block konnte nicht gefunden werden!"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next
End Sub