Mehrschichtplan Kontrollzeile

[Frogger1986]

Meine letzte Formel rechnet auch inkorrekt.. also wieder bei 0

[Frogger1986]

Um eine Prüfung in der Zeile durchzuführen habe ich mir nun eine Eigene Function geschrieben. Jetzt fehlt immer noch die Prüfung beim Schichtwechsel...

Code:

Option Explicit

Function RuheZeiten(L As Range, R As Range) As String
Dim RuheZeit As String
Dim G As Integer
Dim Cell As Range
Dim T As String
Dim S As Long
Dim V As Long



For Each Cell In L
       If Cell.Value <> "" And Cell = Cell.Offset(, 1) Then
       G = G + 1
       T = Cell.Value
       S = Cell.Column
       V = R.Row
       Else
       G = 0
       End If
       If G > 5 Then
       RuheZeit = "Ruhezeit! (" & T & ") am " & Format(Cells(V, S + 1).Value, "DD.MM.YY")
       G = 0
       End If
Next

If RuheZeit = "" Then
RuheZeiten = ""
Else
RuheZeiten = RuheZeit
End If

End Function

[Gast 123]

Hallo

ich habe mir noch mal Gedanken zu einem Prüfmakro gemacht. Würde mich freuen wenn es brauchbar ist.
Es testet ob in jeder einzelnen Zeile der Mitarbeiter mehr als 6x vorkommt.  Dann wird die Zeile gemeldet.

mfg  Gast 123

Code:

Option Explicit      '22.10.2018  für Clever Forum
Const Grün = 43   '(Index)


Sub Ruhezeiten_Prüfung()
Dim f As Integer  'Fehlerzaehler
Dim n As Integer, spa As Integer
Dim j As Integer, Zeile As Integer
Dim lsp As Integer, lze As Integer
Dim Mta As String, FTxt As String

  'LastZell + LastSpalte ermitteln
  lze = Cells(200, 1).End(xlUp).Row
  lsp = Cells(2, 2).End(xlToRight).Column

  'Schleife für alle Spalten auswerten
  For Zeile = 5 To lze
     If Cells(Zeile - 1, 2).Interior.ColorIndex = Grün Then
     ElseIf Cells(Zeile + 1, 2).Interior.ColorIndex = Grün Then
     ElseIf Cells(Zeile, 2).Interior.ColorIndex <> Grün Then
       Mta = Empty  'Mitarbeiter Name löschen
       'Schleife für MTA Namenblöcke auswerten
       For spa = 2 To lsp
           If Cells(Zeile, spa) = Empty Then Mta = Empty
           If Mta = "" And Cells(Zeile, spa) <> "" Then
              Mta = Cells(Zeile, spa): n = 0
              'Anzahl MTA Tage ermitteln
              For j = spa To lsp
                 If Cells(Zeile, j) <> Mta Then Exit For
                 n = n + 1
              Next j
           'ggf. Fehlerauswertung:
           If n > 6 Then
              FTxt = FTxt & Chr(10) & j - spa & "x  " & Mta & " - in Zeile " & Zeile
              f = f + 1
           End If
           'MTA Zellenblock überspringen
           spa = spa + n - 1: Mta = Empty
        End If
     Next spa
     End If
  Next Zeile
 
  If f > 0 Then MsgBox f & " Fehler:  " & FTxt
  If f = 0 Then MsgBox "Ruhezeiten Prüfung - Okay!"
End Sub

[Frogger1986]

Danke! Das ist äußerst nett! Wenn du dem Tread allerdings noch einmal folgst, kannst du sehen, dass ich dafür bereits schon eine Funktion geschrieben habe... Falls dich das ganze Ergebnis interessiert, kann ich dir auch gerne noch das Ergebnis posten...