DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Plaka_Durak_Analizi()
Dim Satir_Listesi As Object, Plaka_Blok_Sayilari As Object
Dim X As Long, Son As Long, Veri As Variant, Say As Long
Dim Plaka_Satirlari As Range, Plaka As Range, Duraklar As Variant
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set Satir_Listesi = CreateObject("Scripting.Dictionary")
Set Plaka_Blok_Sayilari = CreateObject("Scripting.Dictionary")
Range("N3:S" & Rows.Count).ClearContents
Son = Cells(Rows.Count, 8).End(3).Row
If Son < 4 Then Son = 4
Veri = Range("H3:L" & Son).Value
ReDim Liste(1 To UBound(Veri, 1), 1 To 1)
For X = LBound(Veri, 1) To UBound(Veri, 1)
If Not Satir_Listesi.Exists(Veri(X, 5)) Then
Satir_Listesi.Add Veri(X, 5), X
Liste(X, 1) = Veri(X, 5)
Else
Liste(X, 1) = ""
End If
Next
Range("N3").Resize(X - 1, 1) = Liste
Satir_Listesi.RemoveAll
For Each Plaka_Satirlari In Range("N:N").SpecialCells(xlCellTypeConstants, 23).Areas
If Not Plaka_Blok_Sayilari.Exists(Plaka_Satirlari.Offset(, -6).Cells(1, 1).Value) Then
Plaka_Blok_Sayilari.Add Plaka_Satirlari.Offset(, -6).Cells(1, 1).Value, 1
Else
Plaka_Blok_Sayilari.Item(Plaka_Satirlari.Offset(, -6).Cells(1, 1).Value) = _
Plaka_Blok_Sayilari.Item(Plaka_Satirlari.Offset(, -6).Cells(1, 1).Value) + 1
End If
Next
ReDim Liste(1 To UBound(Veri, 1), 1 To 5)
For X = LBound(Veri, 1) To UBound(Veri, 1)
If Not Satir_Listesi.Exists(Veri(X, 5)) Then
Say = Say + 1
Satir_Listesi.Add Veri(X, 5), Say
Liste(Say, 1) = Veri(X, 5)
Liste(Say, 2) = Veri(X, 1)
Liste(Say, 3) = Veri(X, 2)
Liste(Say, 4) = Veri(X, 3)
Liste(Say, 5) = Veri(X, 4)
End If
Next
Range("O3").Resize(Say, 5) = Liste
Range("W4:Y" & Rows.Count).ClearContents
Range("W4").Resize(Cells(Rows.Count, "P").End(3).Row - 2).Value = _
Range("P3:P" & Cells(Rows.Count, "P").End(3).Row).Value
With Range("W4:W" & Rows.Count)
.RemoveDuplicates Columns:=1, Header:=xlNo
.Sort .Cells(1, 1), xlAscending
End With
For Each Plaka In Range("W4:W" & Cells(Rows.Count, "W").End(3).Row)
Plaka.Offset(, 1).Value = Plaka_Blok_Sayilari.Item(Plaka.Value)
Next
With Range("Y4:Y" & Cells(Rows.Count, "W").End(3).Row)
.Formula = "=SUMIF(P:P,W4,R:R)"
.Value = .Value
End With
Range("AA3:AI" & Rows.Count).ClearContents
Range("AA3").Resize(Cells(Rows.Count, "Q").End(3).Row - 2).Value = _
Range("Q3:Q" & Cells(Rows.Count, "Q").End(3).Row).Value
With Range("AA3:AA" & Rows.Count)
.RemoveDuplicates Columns:=1, Header:=xlNo
.Sort .Cells(1, 1), xlAscending
End With
Duraklar = Application.Transpose(Range("AA3:AA" & Cells(Rows.Count, "AA").End(3).Row))
Range("AA3").Resize(, UBound(Duraklar)).Value = Duraklar
With Range("AA4").Resize(Cells(Rows.Count, "W").End(3).Row - 3, UBound(Duraklar))
.Formula = "=SUMIFS($R:$R,$P:$P,$W4,$Q:$Q,AA$3)"
.Value = .Value
.NumberFormat = "hh:mm:ss"
End With
Columns.AutoFit
With Application
.ScreenUpdating = False
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Set Satir_Listesi = Nothing
Set Plaka_Blok_Sayilari = Nothing
End Sub