Makro ile saat alanlarını doldurma

[bthn35]

Merhaba,
EK'teki excelde yapılması gerekenlerini yeşil ile işaretledim. G17 sutünundan itibaren saatleri 08 - 17 ve 09 - 15:30 gibi yazanları aynı satırları saatlerinin altına gelecek şekilde makro ile x koyabilir miyiz?

 

[veyselemre]

Sub test()
    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, 1, 0) - 6
                For ii = bas To son
                    Cells(i, ii).Value = "*"
                Next ii
            End If
        Next i
    End With

End Sub

 

[bthn35]

Çok teşekkür ederim, tam istediğim gibi oldu

 

[bthn35]

Sub test()
    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, 1, 0) - 6
                For ii = bas To son
                    Cells(i, ii).Value = "*"
                Next ii
            End If
        Next i
    End With

End Sub

G sütununda bir format daha varmış, onu da ayarlayabilir misiniz?
Örn: 11 - 16./x/W + 16 - 20./x/W-asd