Yan yana olan benzer hücreleri bulma

[Kumpasta]

Selam.
Hücre verisi alt çizgi olan yan yana 2 veya daha fazla hücrelerin bulundukları sütunun en üstündeki saatleri bulmak istiyorum.
Normal bir kullanıcıyı aşan bir durum olduğu için size sormak istedim.
Örnek dosya ektedir.
Nasıl yapabiliriz acaba? veriler 2000 satır boyunca uzanıyor.

 

[veyselemre]

Sub test()
    [BC3:CC1000].ClearContents
    For i = 3 To Cells(Rows.Count, "F").End(3).Row
        basladi = False
        bas_ = ""
        son_ = ""
        sut = 55
        For ii = 6 To 53
            al = Cells(i, ii).Value
            If basladi = False Then
                If al = "*" Then
                    basladi = True
                End If
            Else
                If al = "_" Then
                    If bas_ = "" Then
                        bas_ = Cells(1, ii).Value
                    Else
                        son_ = Cells(1, ii).Value
                    End If
                Else
                    If son_ <> "" Then
                        Cells(i, sut) = bas_
                        Cells(i, sut + 1) = son_
                        Cells(i, sut).Resize(, 2).NumberFormat = "hh:mm"
                        sut = sut + 3
                    End If
                    bas_ = ""
                    son_ = ""
                End If
            End If
        Next ii
    Next i
End Sub

 

[Kumpasta]

Merhaba.
Çok iyi. Teşekkür ederim. Mükemmel.

Bir kaç ekleme yapabilir miyim?

1- Hatalı kısım varmış ben yanlış anlatmışım. Öncelikle ilk ve son stün gruplarının son sütunundaki bulduğumuz saat değil de son sütunun saatinden sonraki ilk yıldızın saatini aldırabilir miyiz? Yani çizgiler örneğin: 12:00 - 13:00 e denk geliyorsa ve 13:15 de yıldız varsa makro 12:00 - 13:15 yazsa
2- İlgili satırın ilk yıldızının bulunduğu saati BB hücresine ve yine aynı satırın son yıldızını da yan yana kaç gurup varsa o gurubun sonundaki ilk boş hücreye yazsa
3- Son olarak ilk yıldız saatini 15 dk geriye son yıldızı da 15 dk ileriye çekerek yazsa daha da bir şey istemem sağlığınızdan başka.

 

[veyselemre]

Normalde sonradan yapılan değişiklik istekleriyle ilgilenmiyorum, ama sıcağı sıcağına dönüş yaptığınız için uyarlamaya çalıştım.

Sub test()
    [BB3:CC1000].ClearContents
    For i = 3 To Cells(Rows.Count, "F").End(3).Row
        basladi = False
        bas_ = ""
        son_ = ""
        sut = 55
        For ii = 6 To 53
            al = Cells(i, ii).Value
            If basladi = False Then
                If al = "*" Then
                    basladi = True
                    Cells(i, "BB").Value = Cells(1, ii).Value - TimeSerial(0, 15, 0)
                    Cells(i, "BB").NumberFormat = "hh:mm"
                End If
            Else
                If al = "_" Then
                    If bas_ = "" Then
                        bas_ = Cells(1, ii).Value
                    Else
                        son_ = Cells(1, ii).Value
                    End If
                Else
                    If son_ <> "" Then
                        Cells(i, sut).Value = bas_
                        Cells(i, sut + 1).Value = Cells(1, ii).Value
                        Cells(i, sut).Resize(, 2).NumberFormat = "hh:mm"
                        sut = sut + 3
                    End If
                    bas_ = ""
                    son_ = ""
                    sonYildiz = ii
                End If
            End If
        Next ii
        Cells(i, sut).Value = Cells(1, sonYildiz).Value + TimeSerial(0, 15, 0)
        Cells(i, sut).NumberFormat = "hh:mm"
    Next i
End Sub

 

[Korhan Ayhan]

Başlığınızda kullandığınız parantez içindeki bölümün bir anlamı var mı?

Yan yana olan benzer hücreleri bulma (A!)

 

[Kumpasta]

Tekrar merhaba.
Cuk oturdu. Süper oldu.
-15 Dakika geri çektiğimiz veriyi D sütunundan +15 dakika ileri çektiğimiz veriyi ise E sütunundaki verileri baz alabilir mi?
Artık uğraşamam derseniz saygı duyarım <3 Çok yardımcı oldunuz teşekkür ederim.

 

[Kumpasta]

Başlığınızda kullandığınız parantez içindeki bölümün bir anlamı var mı?

Yan yana olan benzer hücreleri bulma (A!)

Korhan bey dikkat çekmesi açısından anlamı olmayan bir bölüm. Kusura bakmayın.

 

[Korhan Ayhan]

Lütfen düzeltiniz.

 

[Kumpasta]

Lütfen düzeltiniz.

Mesaj düzenleme yetkim yok sanırım yada nasıl yapılacağını bilmiyorum Korhan bey.
Tekrarı olmaz. Kusura bakmayın.

 

[Korhan Ayhan]

Tarafımdan gerekli düzenleme yapılmıştır.

 

[Kumpasta]

Tekrar merhaba.
Son bir kısım kaldı.

Mevcut kod ilk yıldızın ( -15 dk geriye çektiğimiz ) ve son yıldızın ( +15 dk eklediğimiz ) bulundukları sütunun en tepesindeki saati baz alıyor. -ilk yıldızı D sütunundan son yıldızı ise E sütunundaki verileri baz alması için kodda değişiklik yapma konusunda yardımcı olur musunuz?

 

[feridici_genc]

Veysel hocam daha iyi bilir ama "ii" ye aldığı verinin kaynağını degistirmek lazım. Tam çözemedim bende belki fikir verebilir sana

 

[feridici_genc]

Hatta
for ii = 6 to 53 ün anlamını bulabilirsek kökten çözeriz herhalde

 

[Kumpasta]

for ii = 6 to 53 çalışma alanını belirliyor bence.
al = Cells(i, ii).Value bu alanda ekle çıkar olması lazımmış gibi düşünüyorum ben.

 

[Ömer]

Merhaba

Sorunuzu tam anlayamadım. D ve E sütunundan alacaksa yıldız aramaya gerek var mı?

 

[Kumpasta]

Kusura bakmayın yazarak tam ifade edemiyorum zorlanıyorum. Özür dilerim.
Sadece ve sadece BB sütununa D sütununda bulunan saatlerin -15 dk azaltılmış olanını yazsın. Bu işlemde yıldız arama gerek yok.
Yine aynı şekilde işlemler hangi sütunda bitiyorsa bittiği hücreden itibaren ilk boş hücreye E sütunundan veriyi alıp üstüne +15 dk eklesin. Bura da da yıldız aramaya gerek yok.

Örneğin:
Makro çalıştı ve BB3 ten itibaren BX3 e kadar sonuçları sıraladı.. BB3 ve BY3 e alınacak verilerin referansı D3 ve E3 alınsın yeterli. ( -15 ve +15 unutulmadan )

 

[Ömer]

İsteğinize göre, Veysel Bey'in kodlarında küçük bir düzeltme yapılmıştır.
Deneyiniz.

Sub test()
    [BB3:CC1000].ClearContents
    For i = 3 To Cells(Rows.Count, "F").End(3).Row
        basladi = False
        bas_ = ""
        son_ = ""
        sut = 55
        Cells(i, "BB").Value = Cells(i, "D").Value - TimeSerial(0, 15, 0) 'yeni ilave
        Cells(i, "BB").NumberFormat = "hh:mm" 'yeni ilave
        For ii = 6 To 53
            al = Cells(i, ii).Value
            If basladi = False Then
                If al = "*" Then
                    basladi = True
                  '  Cells(i, "BB").Value = Cells(1, ii).Value - TimeSerial(0, 15, 0)
                   ' Cells(i, "BB").NumberFormat = "hh:mm"
                End If
            Else
                If al = "_" Then
                    If bas_ = "" Then
                        bas_ = Cells(1, ii).Value
                    Else
                        son_ = Cells(1, ii).Value
                    End If
                Else
                    If son_ <> "" Then
                        Cells(i, sut).Value = bas_
                        Cells(i, sut + 1).Value = Cells(1, ii).Value
                        Cells(i, sut).Resize(, 2).NumberFormat = "hh:mm"
                        sut = sut + 3
                    End If
                    bas_ = ""
                    son_ = ""
                    sonYildiz = ii
                End If
            End If
        Next ii
        'Cells(i, sut).Value = Cells(1, sonYildiz).Value + TimeSerial(0, 15, 0)
        Cells(i, sut).Value = Cells(i, "E").Value + TimeSerial(0, 15, 0) 'yeni ilave
        Cells(i, sut).NumberFormat = "hh:mm"
    Next i
End Sub

 

[Kumpasta]

Ömer bey şu satırda hata veriyor:

Cells(i, "BB").Value = Cells(i, "D").Value - TimeSerial(0, 15, 0) 'yeni ilave

 

[Ömer]

D ve E sütunu boş mu?

 

[Kumpasta]

hayır dolu ve hücrelerdeki veriler saat vede saat formatında.