Makro ile saat alanlarını doldurma

[bthn35]

Merhaba,
EK'teki excel'de resimdeki gibi 08 - 17 ve 09 - 15:30 gibi saatlerin karşısına x koyuyor ancak "11 - 16./x/W + 16 - 20./x/W-asd" olan formatta 11 - 16 ve 16 - 20 olanların karşısına x koymasını istiyorum ancak 16 - 20 olanların karşısına x koymuyor. Nasıl bir ekleme yapmam gerekiyor?

Sub Saat()
    Dim i, ii, a, bl, s1, s2, bas, son

    With CreateObject("VbScript.Regexp")
        .Pattern = "([\d:\s]+)-([\d:\s]+)"
        For i = 17 To Cells(Rows.Count, "G").End(3).Row
            If .test(Cells(i, "G").Value) Then
                Set a = .Execute(Cells(i, "G").Value)
                bl = Split(a(0), "-")
                s1 = Trim(bl(0))
                If InStr(s1, ":") = 0 Then s1 = s1 & ":00"
                s2 = Trim(bl(1))
                If InStr(s2, ":") = 0 Then s2 = s2 & ":00"
                bas = Hour(s1) * 2 + IIf(Minute(s1) = 30, 1, 0) - 6
                son = Hour(s2) * 2 + IIf(Minute(s2) = 30, 0, -1) - 6
                For ii = bas To son
                    Cells(i, ii).Value = "x"
                Next ii
            End If
        Next i
    End With

End Sub