Bestemme om data er ok (2)

Der gik kludder i tabellen. Her er den rigtige.

Kol. A    Kol. B    Kol. C    Kol. D    Kol. E    Kol. F    Kol. G
    Fra    Til    Fra    Til    Fra    Til
Navn 1            13:00    18:00    13:00    18:00
Navn 2    13:00    18:00    13:00    18:00    13:00    18:00
Navn 3            13:00    18:00    13:00    18:00
Navn 4            13:00    18:00    13:00    18:00
Navn 5            13:00    18:00    13:00    18:00
Navn 6            13:00    18:00    13:00    18:00
Navn 7            13:00    18:00    13:00    18:00
Navn 8            13:00    18:00    13:00    18:00
Navn 9            13:00    18:00    13:00    18:00

Kol. H    Kol. I    Kol. J    Kol. K    Kol. L    Kol. M    Kol. N    Kol. O
Fra    Til    Fra    Til    Fra    Til    Fra    Til
13:00    18:00    13:00    18:00    09:00    18:00    09:00    18:00
13:00    18:00    13:00    18:00    10:00    16:00    10:00    16:00
13:00    18:00    13:00    18:00    09:00    13:00    09:00    13:00
13:00    18:00    13:00    18:00    09:00    18:00    09:00    18:00
13:00    18:00    13:00    18:00    14:00    18:00    14:00    18:00
13:00    18:00    13:00    18:00    09:00    13:00    09:00    13:00
13:00    18:00    13:00    18:00    09:00    13:00    09:00    13:00
13:00    18:00    13:00    18:00    14:00    18:00    14:00    18:00
13:00    18:00    13:00    18:00    14:00    18:00    14:00    18:00

Hvis nogen har mod på at løse miit problem kan jeg sende det rigtige tabelformat. Ruden her gør et eller andet ved den.

Ok - prøv at sende filen - kan forsøge - (mailadr. under profil)

Rem Version 1
Rem =========

Rem Rækker
Const skemaStart = 3
Const skemaSlut = 11

Rem Kolonner
Const skemaDagStart = 2
Const skemaDagSlut = 15

Const dataStart = 17
Public Sub kontrolAfTider()
Dim række As Long, ræk As String
Dim navn As String, kl As Date, ugedag As String
Dim checkResultat As Byte
    Application.ScreenUpdating = False
   
Rem traverser data-rækkerne
    For række = dataStart To 65000
        ræk = række
       
        navn = Range("A" & ræk)
        kl = Range("C" & ræk)
        ugedag = Range("D" & ræk)
       
Rem check om slut på data er nået
        If navn = "" Then
            Exit For
        Else
Rem udfør kontrol
            checkResultat = checkDette(LCase(navn), kl, ugedag)
Rem indsæt resultat
            Range("E" & ræk) = checkResultat
        End If
    Next række
   
    Application.ScreenUpdating = True
   
    MsgBox ("Kontrol afsluttet")
End Sub
Private Function checkDette(navn, kl, ugedag)
Dim navneRække As Long, ugedagKolonne As Byte, fra As Date, til As Date
    navneRække = findNavn(navn)
    If navneRække > 0 Then
        ugedagKolonne = findUgedag(LCase(ugedag))
       
        If ugedagKolonne > 0 Then
            fra = Cells(navneRække, ugedagKolonne)
            til = Cells(navneRække, ugedagKolonne + 1)
           
            If kl >= fra And kl <= til Then
                checkDette = 1
            Else
                checkDette = 0
            End If
        Else
            MsgBox ("Ugedag: " & ugedag & " ikke fundet i skema")
        End If
    Else
        MsgBox ("Navnet: " & navn & " ikke fundet i skema")
    End If
End Function
Private Function findNavn(navn)
Dim ræk As Integer
    For ræk = skemaStart To skemaSlut
        If navn = LCase(Range("A" & CStr(ræk))) Then
            findNavn = ræk
            Exit Function
        End If
    Next ræk
   
    findNavn = 0
End Function
Private Function findUgedag(ugedag)
Dim kol As Byte
    For kol = skemaDagStart To skemaDagSlut
        If InStr(LCase(Cells(1, kol)), ugedag) = 1 Then
            findUgedag = kol
            Exit Function
        End If
    Next kol
   
    findUgedag = 0
End Function