Sub Top5MusteriRaporu()
Dim ws As Worksheet
Dim lastRow As Long
Dim musteriList As Object
Dim musteri As Variant
Dim i As Long, j As Long, k As Long
Dim outputRow As Long
Dim tempArr() As Variant
Dim tempCount As Long
Dim outputSheet As Worksheet
On Error Resume Next
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set musteriList = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
If Not musteriList.exists(ws.Cells(i, 1).Value) Then
musteriList.Add ws.Cells(i, 1).Value, 1
End If
Next i
On Error Resume Next
Set outputSheet = Worksheets("Top5Rapor")
If outputSheet Is Nothing Then
Set outputSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
outputSheet.Name = "Top5Rapor"
Else
outputSheet.Cells.Clear
End If
On Error GoTo 0
outputSheet.Cells(1, 1).Value = "MÜŞTERİ"
outputSheet.Cells(1, 2).Value = "VARIŞ İL"
outputSheet.Cells(1, 3).Value = "VARIŞ İLÇE"
outputSheet.Cells(1, 4).Value = "ARAÇ SAYISI"
outputSheet.Range("A1:D1").Font.Bold = True
outputSheet.Range("A1:D1").HorizontalAlignment = xlCenter
outputRow = 2
For Each musteri In musteriList.Keys
Dim locationDict As Object
Set locationDict = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
If ws.Cells(i, 1).Value = musteri Then
Dim key As String
Dim ilce As String, il As String, aracSayisi As Long
il = ws.Cells(i, 2).Value
ilce = ws.Cells(i, 3).Value
key = il & "|" & ilce
aracSayisi = ws.Cells(i, 4).Value
If locationDict.exists(key) Then
locationDict(key) = locationDict(key) + aracSayisi
Else
locationDict.Add key, aracSayisi
End If
End If
Next i
tempCount = locationDict.Count
If tempCount > 0 Then
ReDim tempArr(1 To tempCount, 1 To 3)
j = 1
For Each key In locationDict.Keys
Dim parts As Variant
parts = Split(key, "|")
tempArr(j, 1) = parts(0)
tempArr(j, 2) = parts(1)
tempArr(j, 3) = locationDict(key)
j = j + 1
Next key
For j = 1 To tempCount - 1
For k = j + 1 To tempCount
If tempArr(j, 3) < tempArr(k, 3) Then
Dim tempIl As String, tempIlce As String, tempSayi As Long
tempIl = tempArr(j, 1)
tempIlce = tempArr(j, 2)
tempSayi = tempArr(j, 3)
tempArr(j, 1) = tempArr(k, 1)
tempArr(j, 2) = tempArr(k, 2)
tempArr(j, 3) = tempArr(k, 3)
tempArr(k, 1) = tempIl
tempArr(k, 2) = tempIlce
tempArr(k, 3) = tempSayi
End If
Next k
Next j
Dim topCount As Integer
topCount = Application.WorksheetFunction.Min(5, tempCount)
For j = 1 To topCount
outputSheet.Cells(outputRow, 1).Value = musteri
outputSheet.Cells(outputRow, 2).Value = tempArr(j, 1)
outputSheet.Cells(outputRow, 3).Value = tempArr(j, 2)
outputSheet.Cells(outputRow, 4).Value = tempArr(j, 3)
outputRow = outputRow + 1
Next j
End If
Next musteri
outputSheet.Columns("A:D").AutoFit
outputSheet.Activate
outputSheet.Range("A1").Select
MsgBox "Top 5 müşteri raporu oluşturuldu!", vbInformation
End Sub
