Makro ile sıralama

[Korhan Ayhan]

Şu şekilde düzenleyiniz.

 

[şehiriçi]

Korhan bey ,düzenlemeyi yaptım 44 adet blok oluşturdum.
bu arada bloklar bizim durak yerlerimizdir.
boş olan durak yerlerine ilerde ihtiyaç oldukça blok ekleyebilirim . yani blok sayısı 44 le sınırlı kalmamalı ki icabında 45 , 46 bloğuda sonradan ilave edebileyim .

 

[Korhan Ayhan]

Listeleme hangi sütuna yapılacak?

 

[şehiriçi]

H , I ,J uygun Korhan bey

 

[Korhan Ayhan]

Bu arada Blok7-Blok8 aynı... Siz kontrol edersiniz. Ben kod içinde mükerrer olanları dikkate almayacak şekilde düzenleme yaptım.

Deneyiniz.

Option Explicit

Sub Bloklari_Ara_Uyanlari_Listele()
    Dim Zaman As Double, Blok_Listesi As Object, Blok_Sayilari As Object, X As Long, Bloklar As Range
    Dim Y As Long, Blok_Say As Long, Son As Long, Veri As Variant, Sayi As Variant, Say As Long
   
    Zaman = Timer
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    Set Blok_Listesi = CreateObject("Scripting.Dictionary")
    Set Blok_Sayilari = CreateObject("System.Collections.ArrayList")
   
    Range("H3:L" & Rows.Count).ClearContents
   
    Son = Cells(Rows.Count, 2).End(3).Row
    If Son < 4 Then Son = 4
   
    Veri = Range("A3:B" & Son).Value
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        ReDim Blok_Yer_Listesi(1 To 1)
        Say = 0
        If Veri(X, 2) <> "" Then
            Say = Say + 1
            ReDim Preserve Blok_Yer_Listesi(1 To Say)
            Blok_Yer_Listesi(Say) = WorksheetFunction.Trim(Veri(X, 2))
           
            For Y = X + 1 To UBound(Veri, 1)
                If Veri(Y, 2) <> "" Then
                    If Veri(X, 1) = Veri(Y, 1) Then
                        Say = Say + 1
                        ReDim Preserve Blok_Yer_Listesi(1 To Say)
                        Blok_Yer_Listesi(Say) = WorksheetFunction.Trim(Veri(Y, 2))
                    Else
                        If Not Blok_Sayilari.Contains(Say) Then Blok_Sayilari.Add Say
                        If Not Blok_Listesi.Exists(WorksheetFunction.Trim(UCase(Replace(Replace(Join(Blok_Yer_Listesi, ","), "ı", "I"), "i", "İ")))) Then
                            Blok_Say = Blok_Say + 1
                            Blok_Listesi.Add WorksheetFunction.Trim(UCase(Replace(Replace(Join(Blok_Yer_Listesi, ","), "ı", "I"), "i", "İ"))), Blok_Say
                        End If
                        Set Bloklar = Nothing
                        X = Y - 1
                        Exit For
                    End If
                End If
            Next
        End If
    Next

    Son = Cells(Rows.Count, "D").End(3).Row
    If Son < 4 Then Son = 4

    Veri = Range("D3:F" & Son).Value

    Blok_Sayilari.Sort
    Blok_Sayilari.Reverse

    ReDim Yer(1 To 1)
    ReDim Liste(1 To UBound(Veri, 1), 1 To 5)

    Say = 0

    For X = LBound(Veri, 1) To UBound(Veri, 1)
        For Each Sayi In Blok_Sayilari
            For Y = 1 To Sayi
                If (X + Y - 1) > UBound(Veri, 1) Then Exit For
                ReDim Preserve Yer(1 To Y)
                Yer(Y) = WorksheetFunction.Trim(Veri(X + Y - 1, 2))
            Next
           
            If Blok_Listesi.Exists(WorksheetFunction.Trim(UCase(Replace(Replace(Join(Yer, ","), "ı", "I"), "i", "İ")))) Then
                For Y = 1 To Sayi
                    Say = Say + 1
                    Liste(Say, 1) = Veri(X + Y - 1, 1)
                    Liste(Say, 2) = WorksheetFunction.Trim(Veri(X + Y - 1, 2))
                    Liste(Say, 3) = Veri(X + Y - 1, 3)
                    Liste(Say, 4) = Blok_Listesi.Item(WorksheetFunction.Trim(UCase(Replace(Replace(Join(Yer, ","), "ı", "I"), "i", "İ"))))
                    Liste(Say, 5) = X + Y + 1
                Next
            End If
        Next
    Next

    If Say > 0 Then
        Range("H3").Resize(Say, 5) = Liste
        Range("J3").Resize(Say).NumberFormat = "hh:mm:ss"
        Columns.AutoFit
       
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
       
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
       
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If
   
    Set Blok_Listesi = Nothing
    Set Blok_Sayilari = Nothing
End Sub

 

[şehiriçi]

evet Korhan bey yine atlamışım üstelik çok da dikkat etmiştim . blok7 yerine farklı bir blok oluştururum artık ayrıca mükerrer olanları dikkate almayacak şekilde düzenlemeniz de çok iyi oldu . Ben yazdığınız kodu deneyeceğim çok teşekkürler.

 

[şehiriçi]

Korhan bey , 42 gbc 03 plakalı araç 204_213 .satırlarda blok_1 le eşleşmesi gerek aynı şekilde 42 gbc 03 plakalı araç 204_212 satırlarda blok_2 ile eşleşmiş
blok_2 yi yazdırmışsınız ama blok_1 yazılmamış , bu düzenlemeden önce yukarıda renke göre yaptığınızda bu durum vardı , yani kısacası her ikisininde görünmesini istiyorum. blok_1 i yazmayınca araç Adliye parkına girmemiş gibi durum oluşuyor oysa 213 .satırla Adliye Parkına girmiş

 

[Korhan Ayhan]

Verilerinizde ki boşluk karakterlerini kontrol etmelisiniz. Yazım hatalarına dikkat etmelisiniz.

E206 ve E212 hücrelerini kontrol ediniz.

 

[şehiriçi]

Selam Excel dostları ,3-5 gündür bazı işler sebebiyle yarım kalan dosyam ile ilgilenemedim , Allah kendisinden razı olsun Korhan beyin yardımıyla projemde epey yol aldım . Kendisine çok teşekkür ederek hemen kafama takılan ve test ettiğim dosyamdaki eksikliğe bakalım

1. Korhan hocam 28 mesajınızdaki yazım hatası uyarınız doğru çıktı onu düzelttim ve tekrar olmaması içinde for next döngüsü ile kod şeklinde yazdım hata "Zafer" olması geren "Zafer ", ikinci zaferdeki r den sonraki boşluk muş , düzeldi

2. 42 gbc 02 , 42 gbc 07 ,42 gbc 16 plakalı araçlar istediğim gibi sehirici sayfasında H_L sütunları arasına DEF sütunundan B sütunundaki gibi bir blok varsa getirmiş. Ancak 42 gbc 22 , 42 gbc 27 ,42 gbc 17 ,42 gbc 20 bu 4 araç ile ilgili bloklar H_L sütunlrına aktarılmamış

2 maddede ki bilgiler için lütfen ek dosyaya bakınız

 

[şehiriçi]

Merhaba , Korhan hocam ve diğer tüm excel dostları beni unutmayınız inşallah o yüzden güncel hale getiriyorum

 

[şehiriçi]

Merhaba Korhan Bey ,verdiğiniz kod için teşekkürler . Ancak verdiğiniz kod da bir sınırlama var , şöyleki ;
Dosyamın şehirici sayfasında B sütununda belirlediğimiz blokları gören araç sayısı 7 tane fakat sizin verdiğiniz kod da bu araçlardan sadece 3 tanesine cevap veriyor onlar da 42 gbc 02 ,42 gbc 07 ve 42 gbc 16 plakalı araçlar dır .
Fakat 42 gbc 22 , 42 gbc 20 , 42 gbc 17 ve 42 gbc 27 plakalı araçlarda B sütununda bulunan blokların bir çoğunu gördüğü halde H I J K L sütunlarına aktarılmamış .

 

[Korhan Ayhan]

Son paylaştığınız dosyada 7. ve 8. bloklar aynı görünüyor.

Kodun çalışma mantığından kısaca bahsedeyim.

Kod ilk olarak A-B sütunlarındaki benzersiz blokları ve bloklar içindeki veri sayılarını hafızaya alıyor.
Sonra D-E-F aralığını sorgulamaya başlıyor. Burada sorgulama işinde ilk olarak en büyük veri sayısı içeren bloktan işleme başlıyor.
Bu dosyada toplam 42 adet benzersiz blok sayısı buluyor. Bu blokların içindeki veri sayısı en az 7 en çok 13 olarak görünüyor. Kod verileri ilk önce 13'lü bloklar şeklinde tek tek sorguluyor. Eşleşme yakalarsa bu durakların yanına ilgili blok numarasını işliyor. Bu şekilde son veriye kadar kontrol yapılıyor.

Tekrar belirtiyorum kodlamada bir sınırlama yok. Sadece kurgusal hata olabilir.

Siz mesela paylaştığınız dosyada şu satırdaki veriler şu blok numarası olması gerekiyor dediğiniz bir veri varsa ona odaklanıp çözüm yoluna gidelim.

 

[şehiriçi]

Korhan bey son paylaştığım dosyadaki 7 bloğu benzersiz hale getirdim yani yeni bir blok yaptım , başka varmı varsa değiştireyim .

N sütununda zemin rengi yeşil olan N3_N5 aralığında 3 adet plaka var (42 gbc 02 , 42 gbc 07 ve 42 gbc 16) bunlarla ilgili bir sıkıntım yok ,yazdığınız kod bu plakalara göre gerekli blokları H,I,J sütunlarına taşımış

Ancak yine N sütununda zemin rengi mavi olan N10_N13 aralığındaki 4 adet plaka ya ait (42 gbc 22 , 42 gbc 27 , 42 gbc 17 ve 42 gbc 20 ) ait de D,E,F sütunlarında bloklar var . yazdığınız bu kod , bu 4 plakaya ait ,o blokları niye getirmiyor

 

[Korhan Ayhan]

Sorunu buldum..

"Son" değişkeni "A" sütununa tanımlı kalmış. Şimdi "D" sütunu olacak şekilde revize ettim. #25 nolu mesajımda ki kodu revize ettim.

Deneyip sonucu bildirirsiniz.

 

[şehiriçi]

Korhan bey tam istediğim gibi mükemmel olmuş B sütununda olan blokları E sütununda arıyor ve bulduğu blokların olduğu D,E,F sütunlarını da satır no ve blok no su ile beraber H,I,J,K,L sütunlarına yazdırıyor...
Buraya kadar her şey mükemmel bundan sonra kolayı kaldı , ama sizin için bana göre hala zor ,Şöyle ki ;
Ben dosya da A ve B sütunundaki verileri kod şeklinde yazdırdım kısaca dosyada revizyon ettim .şimdi sonuca ulaşmaya ramak kaldı . Nedir bu eksiklerim

1_Sizin kod H,I,J,K,L sütunlarını doldurduktan sonra ben M sütununu boş bıraktım N veO sütunlarına benzersiz olan satır numaralarını kod ile yazdırttım .çünki benim ileride ki hesaplamamda bana sadece 1 satır No 1 kere lazım olacak ,ve P,Q,R,S sütunlarına ben bunları formülle girdim .İşte soru burda Bu P,Q,R,S sütunlarınıda kod ile yazdırmak

2_W sütununa Çalışan Araçların tespitini yapıp yazdırmak o araçlarda P sütununda hepsi var sadece aynı plakayı 1 kez yazdırmak ben elle yazdım

3_ X sütununa bu araçların tur sayısını yazdırmak (her bir blok = 1 tur dur)

4_Y sütununa araçların toplam ihlallerini yazdırmak , ben R sütunundan ele toplayıp Y sütununa yazdırdım

5_Son olarak aynı ihlallerin durak bazında toplamlarını yazdırmak AA_AI sütunları arasına

Bunları da tamamladık mı , Korhan bey , yardımınızla aylardır uğraştığım projemin sonuna gelmiş olacağım
Durak takip programına ihtiyacı olan arkadaşlara faydalı bir kaynak olacağını umuyorum
Revize edilmiş son dosyam ekte

 

[Korhan Ayhan]

X sütunundaki tur sayılarını nasıl hesapladınız? Bir kontrol eder misiniz?

 

[şehiriçi]

Korhan bey bir blok =1 tur demek yani B sütununa yazdığımız her blok aslında 1 tur dur .
X sütunu tur sayısını hesaplarken Q sütununu baz aldım.

 

[Korhan Ayhan]

Tamam X4 hücresinde yazan 11 değerine nasıl ulaştınız. Nereyi sayıp yazdınız.

 

[şehiriçi]

X sütunu tur sayısını hesaplarken Q sütununu baz aldım.

 

[Korhan Ayhan]

Nasıl saydınız?