ich habe ein funktionierendes Makro bei welchem mir Piet erfolgreich geholfen hatte.
Jetzt taucht aber ein Problem auf:
Ich habe innerhalb der abzufragenden Spalten leere Zellen.
Anbei das auszuführende Makro:
Sub Zwischenzeit_test_23_08Uhr58()
Dim RaumWert As String
Dim EndZeitWert As String 'Wert Endzeit
Dim Zeile As Long
Dim EinfügWert As String
Dim rfind As Object, lazRaum As Integer
'neu eingefügt_Peter_2017-06-16-11.31Uhr
Dim EinfügWert2 As String
Dim EinfügWert3 As String
'für AnfangZwischenzeit
Dim SuZwiZeit As String
Dim ZwZeitfind As Object
Dim AZeit As Date, zAZeit As Date
Dim EZeit As Date, zEZeit As Date
'LastZell in Räume Spalte C ermitteln
lazRaum = Worksheets("Räume").Range("C500").End(xlUp).Row
'Schleife für alle Anfangs Zeiten
For j = 2 To lazRaum
'aktuelle Anfangzeit ermitteln
Zelle_A = Worksheets("Räume").Cells(j, "C").Value 'Anfangzeit
With Worksheets("Zeiten_Gesamt (2)")
Set rfind = .Range("G2:G51").Find(What:=Zelle_A, After:=Range("G2"), _
LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then AZeitSpalte = rfind.Offset(0, -1).Value
End With
'Debug.Print Zelle_A
'Debug.Print AZeitSpalte
'aktuelle Endzeit ermitteln
Zelle_E = Worksheets("Räume").Cells(j, "D").Value 'Endzeit
With Worksheets("Zeiten_Gesamt (2)")
Set rfind = .Range("G2:G51").Find(What:=Zelle_E, After:=Range("G2"), _
LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rfind Is Nothing Then EZeitSpalte = rfind.Offset(0, -1).Value
End With
'Debug.Print Zelle_E
'Debug.Print EZeitSpalte
'aktuelle AnfangZwischenzeit ermitteln
SuZwiZeit = Worksheets("Hilfstabelle").Cells(5, "D").Value
With Worksheets("Zwischenzeiten")
Set ZwZeitfind = .Range("A2:A51").Find(What:=SuZwiZeit, After:=Range("A2"), _
LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not ZwZeitfind Is Nothing Then ZwZAZeitSpalte = ZwZeitfind.Offset(0, 2).Value
End With
'Debug.Print ZwZAZeitSpalte
'aktuelle EndZwischenzeit ermitteln
With Worksheets("Zwischenzeiten")
Set ZwZeitfind = .Range("A2:A51").Find(What:=SuZwiZeit, After:=Range("A2"), _
LookIn:=xlValues, lookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not ZwZeitfind Is Nothing Then ZwZEZeitSpalte = ZwZeitfind.Offset(0, 4).Value
End With
'Debug.Print ZwZEZeitSpalte
' Eingabe = Worksheets("Räume").Cells(j, "A").Value 'Raum
RaumWert = Worksheets("Räume").Cells(j, "A").Value 'Raum
' EinfügWert = Worksheets("Hilfstabelle").Cells(j, "P").Value
EinfügWert = Worksheets("Hilfstabelle").Range("P2").Value 'nicht anwesend
'neu eingefügt_Peter_2017-06-16-11.31Uhr
EinfügWert2 = Worksheets("Hilfstabelle").Range("P3").Value '=nicht elektronisch buchbar
EinfügWert3 = Worksheets("Hilfstabelle").Range("P5").Value 'leer
With Worksheets("Buchung_Räume")
Zeile = .columns("A:A").Find(What:=RaumWert, After:=Range("A1"), _
LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
End With
'Text Zeiten in echtes Zeit-Format umwandeln
AZeit = CDate(Left(Zelle_A, 2) & ":" & Mid(Zelle_A, 4, 2))
EZeit = CDate(Left(Zelle_E, 2) & ":" & Mid(Zelle_E, 4, 2))
zAZeit = CDate(Left(ZwZAZeitSpalte, 2) & ":" & Mid(ZwZAZeitSpalte, 4, 2))
zEZeit = CDate(Left(ZwZEZeitSpalte, 2) & ":" & Mid(ZwZEZeitSpalte, 4, 2))
' Debug.Print AZeit
' Debug.Print EZeit
' Debug.Print zAZeit
' Debug.Print zEZeit
Worksheets("Buchung_Räume").Activate
If EZeit > AZeit And zEZeit > EZeit Then
ActiveSheet.Range(Cells(Zeile, 30), Cells(Zeile, 33)) = EinfügWert 'nicht anwesend
Else
ActiveSheet.Range(Cells(Zeile, 30), Cells(Zeile, 33)) = EinfügWert2 'nicht elekronisch buchbar
End If
If AZeit > zAZeit And zEZeit
Der Fehler geginnt an dieser Stelle: 'Text Zeiten in echtes Zeit-Format umwandelnSobald die Zelle_A und Zelle_E leer ist kommt Laufzeitfehler.
Es soll bei leeren Zellen nicht nichts passieren sondern es soll nachstehendes aus-
geführt werden:
ActiveSheet.Range(Cells(Zeile, 30), Cells(Zeile, 33)) = EinfügWert 'nicht anwesend
Könnt ihr mir bitte bei meinem Problem behilflich sein.
Besten Dank
Gruss
Peter