aynı saatleri bölmelere ayrıma

[bugrahandabanca]

Merhaba exceldeki gibi aynı saatlerin bulunduğu satırları düşey ara ile ayırmak istedim ancak aynı saatler olduğu için yapamadım. mavı kısımı doldurduğumda yan tarafındaki saat dilimlerine göre ayrılması için yardımcı olurmusunuz.
saat 10 satırları ayrı 12 satırları ayrı gibi(normade saat dilimleri çok daha fazla kısalttım )

 

[bugrahandabanca]

Saat dilimindeki satırlar değişeceği için saatleri baz alarak geçirilmesi gerekiyor. yardımcı olurmusunuz.

 

[ÖmerFaruk]

sadece 00:00 - 10:00 -12:00 - 14:00 mıdır gruplarınız?
ve 00:00 da tablonuzda 8 satır var 3ü dolu. Bu satır sayısı artar mı ?
Neden bu tabloları böyle yapıyorsunuz?
Sütunlara dizilseler de alta ne kadar satır gelirse gelsin desek olmaz mı aşağıdkai resimdeki gibi

 

[bugrahandabanca]

grup sayıları 00.00 10.00 12.00 14.00 16.00 18:00 20.00 oolacaktır. sembolik 8 satır yaptım satır sayısı artabilir (rsimdeki gibi ), aşağı kadar ne kadar olursa olsun diyebiliiriz. günlük gelen raporu yapıştırdığımda bu şekilde ayrışmasını istiyorum . (pivot yaparak denedğimde işimi görmedi )

 

[ÖmerFaruk]

Peki o zaman şöyle sorayım.

00:00 tablocuğu hep H4 den başlayacak ve 20 tane veri var yani H24 de bitiyor
Bir sonraki (10:00) hep L4 den başlayacak ve 2 tane veri var L6 da bitiyor

Bunlardan sonra gelecek olan (mesela 12:00 ve 14:00) tabloucuklarının başlık satırları hangi hücreler olacak?

 

[bugrahandabanca]

tablocukların nerde oldugunun bir önemi yok istenilen yerde olabilir. önemli olan verilerin olduğu kısımı (a b c 1den 22) ye kadar olan kısımın saatlere göre satırlar halinde ayrışması

 

[ÖmerFaruk]

Aşağıdaki kodları Modül içine yapıştırarak Sayfa içindeylen çalıştırabilirsiniz.

Sub BugraHanDabanca()
Dim xRow%, xCol%, Son%, SonSat%, i%, Say%
    Son = Range("A1").End(xlDown).Row
    xRow = 2
    xCol = 8
    Range("H:N").Clear
    Range("H:H,L:L").NumberFormat = "hh:mm;@"
    For i = 1 To Son
        Say = WorksheetFunction.CountIf(Range("A1:A" & Son), Cells(i, 1))
        Range("A" & i, "C" & i + Say - 1).Copy
        Cells(xRow, xCol).Resize(Say, 3).PasteSpecial xlValues
        Cells(xRow - 1, xCol) = Cells(i, 1)
        Cells(xRow - 1, xCol).Resize(1, 3).Merge
        Cells(xRow - 1, xCol).Interior.Color = vbGreen
        Cells(xRow - 1, xCol).HorizontalAlignment = 3
        Cells(xRow - 1, xCol).Font.Bold = True
        SonSat = WorksheetFunction.Max(xRow + Say, SonSat)
        If xCol = 8 Then
            xCol = 12
        Else
            xCol = 8
            xRow = SonSat + 2
        End If
        i = i + Say - 1
    Next i
End Sub

 

[bugrahandabanca]

teşekkkür ederim üstat. ben tam anlatamadığım için biraz eksik oldu. biraz değiklik için yardımcı olurmusun. en aşağıya 10:00 için bir satır eklediğimde 18:00 a yazıyor alta doğru bu saat dilimlerinden sürekli gelecek. birde rakamı abc sütununa yazdığımız anda tablocuklara anlık otomatik geçmesi yapılabilir mi, Şuan her seferinde play yaomak zorunda kalıyoruz. (uğraştırdım kusura bakma)

 

[ÖmerFaruk]

Bu sebeple size zaten bir sürü soru sorarak sorunuza cevap üretmeye çalışıyordum. Verdiğiniz örnek exceller kendini belli ediyordu bir şeyleri eksik tanımladığınızı.
Şu an şu kadar söyleyeyim, bu son isteğinizle beraber tüm çözüm değişmek zorunda.
Ben biraz kafamı dinlemek istiyorum. Kusura bakma.