Soru Excel verisinden makro ile rapor üretme

[tcilek]

Merhabalar Üstadlar;

Firmamıza bağlı santralden edindiğim bir excel verisi var ve benden bu verilerden günlük olarak belirli dahililerin gelen görüşme sayısı, görüşme süresi ve görüşmelere ortalama kaç dakika harcandığı, cevaplamadığı çağrıları, reddettikleri ve dış aramaları listelemem istendi. Konu ile excel dosyasında 30.000 civarı görüşme sayısı var ve hergün artmakta manual yapmak çok zor olacağı için sizlerden yardım talep etmekteyim.

Örnek Dosya: https://drive.google.com/file/d/1s2TkylQRT-cfAuZSfTiihX7QWfpD-6ls/view?usp=sharing

 

[Muzaffer Ali]

Nasıl bir sonuç istiyorsanız manuel olarak örnek dosyanızda siz yapın.
Biz de bu örneğe bakarak işlemleri otomatik yapalım.

 

[tcilek]

Merhabalar Üstadlar;

Dediğiniz gibi ben manual filtreler yardımıyla manual bir adet rapor hazırladım aşağıda linkini payaşıyorum.

Link: https://drive.google.com/open?id=1cPBxRf7N_FKlMp0gJ3S1RVBMgnHPmcxz

 

[Muzaffer Ali]

Merhaba.

Dosyanız ekte indirip inceleyin.

https://www.dosyaupload.com/a4c2

A sutununda bulunan dahili numaralara göre rapor hazırlar.

 

[tcilek]

Dalgalıkur üstadım ellerine sağlık, ufak bir sıkıntı var her butona basışımda rakamlar değişiyor veri aynı veri rakamlarda değişiklik olmamalı değilmi?

 

[Muzaffer Ali]

Tamam.
Verileri silmeden tekrar üzerine topluyor.
Şimdi düzenliyorum.

 

[Muzaffer Ali]

Rapor sayfasını sağ tıklatıp kod görüntüle seçin

Dim BakVeri As Range
satırının altına aşağıdaki satırı ekleyin

Range("B3:I" & Cells(Rows.Count, "A").End(3).Row).ClearContents

 

[tcilek]

Üstadım, ellerinize sağlık. Bir ufak isteğim daha var cevapsız arama ile reddedilen aramalar da gelen arama içerisinde gösterilmekte. Bunları gelen çağrılar içerisinde görmez isek daha iyi ve doğru istatistiki bilgi olacak kanaatindeyim.

 

[Muzaffer Ali]

O zaman kodlar şöyle oldu.

Option Explicit

Private Sub btnRapor_Click()
    Dim VeriSay As Long
    Dim Bak As Range
    Dim BakVeri As Range
    Range("B3:I" & Cells(Rows.Count, "A").End(3).Row).ClearContents
    With Worksheets("Veri")
        VeriSay = .Cells(Rows.Count, "A").End(3).Row
        For Each Bak In Range("A3:A" & Cells(Rows.Count, "A").End(3).Row)
            Bak(1, 3).Value = WorksheetFunction.SumIf(.Range("K:K"), Bak, .Range("F:F"))
            If Not Bak(1, 2).Value = 0 Then
                Bak(1, 4).Value = Bak(1, 3).Value / Bak(1, 2).Value
            Else
                Bak(1, 4).Value = 0
            End If
            Bak(1, 7).Value = WorksheetFunction.CountIf(.Range("P:P"), Bak)
            Bak(1, 8).Value = WorksheetFunction.SumIf(.Range("P:P"), Bak, .Range("F:F"))
            If Not Bak(1, 7).Value = 0 Then
                Bak(1, 9).Value = Bak(1, 8).Value / Bak(1, 7).Value
            Else
                Bak(1, 9).Value = 0
            End If
            For Each BakVeri In .Range("K1:K" & VeriSay)
                If Bak = BakVeri Then
                    Select Case .Cells(BakVeri.Row, "AE")
                        Case "Cevapsız"
                            Bak(1, 5).Value = Bak(1, 5).Value + 1
                        Case "Reddetme"
                            Bak(1, 6).Value = Bak(1, 6).Value + 1
                        Case Else
                            Bak(1, 2).Value = Bak(1, 2).Value + 1
                    End Select
                End If
            Next
        Next
    End With
End Sub

 

[Muzaffer Ali]

Eğer AE sutununda "Reddetme" ve "Cevapsız" yazıyorsa toplamaz.
AE sutununu boşsa, "Cevapsız, Taşma" ve "Transfer" yazıyorsa toplar

 

[tcilek]

Üstad; ellerin dert görmesin. Herşey tamam ama bu seferde gelen aramaların çağrı sürelerinin ortalamasını sıfır olarak getiriyor.

 

[Muzaffer Ali]

Onu gözden kaçırmışım.
Aşağıdaki kodları kontrol edin.

Option Explicit

Private Sub btnRapor_Click()
    Dim VeriSay As Long
    Dim Bak As Range
    Dim BakVeri As Range
    Range("B3:I" & Cells(Rows.Count, "A").End(3).Row).ClearContents
    With Worksheets("Veri")
        VeriSay = .Cells(Rows.Count, "A").End(3).Row
        For Each Bak In Range("A3:A" & Cells(Rows.Count, "A").End(3).Row)
            Bak(1, 7).Value = WorksheetFunction.CountIf(.Range("P:P"), Bak)
            Bak(1, 8).Value = WorksheetFunction.SumIf(.Range("P:P"), Bak, .Range("F:F"))
            If Not Bak(1, 7).Value = 0 Then
                Bak(1, 9).Value = Bak(1, 8).Value / Bak(1, 7).Value
            Else
                Bak(1, 9).Value = 0
            End If
            For Each BakVeri In .Range("K1:K" & VeriSay)
                If Bak = BakVeri Then
                    Select Case .Cells(BakVeri.Row, "AE")
                    
                        Case "Cevapsız"
                            Bak(1, 5).Value = Bak(1, 5).Value + 1
                        Case "Reddetme"
                            Bak(1, 6).Value = Bak(1, 6).Value + 1
                        Case Else
                            Bak(1, 2).Value = Bak(1, 2).Value + 1
                    End Select
                End If
            Next
            Bak(1, 3).Value = WorksheetFunction.SumIf(.Range("K:K"), Bak, .Range("F:F"))
            If Not Bak(1, 2).Value = 0 Then
                Bak(1, 4).Value = Bak(1, 3).Value / Bak(1, 2).Value
            Else
                Bak(1, 4).Value = 0
            End If
        Next
    End With
End Sub

 

[tcilek]

Üstad harikulade ellerin dert görmesin teşekkür ederim.

 

[tcilek]

Konu Bayağı eskimiş ama üstad müsaitsen bir konu var idi bu raporu üretirken gelen çağrı toplam süre ile dış arama toplam süresi sanki 24:00:00 dan sonra sıfırlayarak topluyor yani 27 saat konuşan hiç olmuyor. inşallah açıklamayı yapabilmişimdir. Konuyu tekrar hortlattığım için de ayrıyeten özür dilerim.

 

[tcilek]

Onu gözden kaçırmışım.
Aşağıdaki kodları kontrol edin.

Option Explicit

Private Sub btnRapor_Click()
    Dim VeriSay As Long
    Dim Bak As Range
    Dim BakVeri As Range
    Range("B3:I" & Cells(Rows.Count, "A").End(3).Row).ClearContents
    With Worksheets("Veri")
        VeriSay = .Cells(Rows.Count, "A").End(3).Row
        For Each Bak In Range("A3:A" & Cells(Rows.Count, "A").End(3).Row)
            Bak(1, 7).Value = WorksheetFunction.CountIf(.Range("P:P"), Bak)
            Bak(1, 8).Value = WorksheetFunction.SumIf(.Range("P:P"), Bak, .Range("F:F"))
            If Not Bak(1, 7).Value = 0 Then
                Bak(1, 9).Value = Bak(1, 8).Value / Bak(1, 7).Value
            Else
                Bak(1, 9).Value = 0
            End If
            For Each BakVeri In .Range("K1:K" & VeriSay)
                If Bak = BakVeri Then
                    Select Case .Cells(BakVeri.Row, "AE")
                   
                        Case "Cevapsız"
                            Bak(1, 5).Value = Bak(1, 5).Value + 1
                        Case "Reddetme"
                            Bak(1, 6).Value = Bak(1, 6).Value + 1
                        Case Else
                            Bak(1, 2).Value = Bak(1, 2).Value + 1
                    End Select
                End If
            Next
            Bak(1, 3).Value = WorksheetFunction.SumIf(.Range("K:K"), Bak, .Range("F:F"))
            If Not Bak(1, 2).Value = 0 Then
                Bak(1, 4).Value = Bak(1, 3).Value / Bak(1, 2).Value
            Else
                Bak(1, 4).Value = 0
            End If
        Next
    End With
End Sub

dalgalıkur üstadım sana işim düştü mümkünse bu kodlar ile toplamını aldığımız saatlerde 00:01:00 dan az olan görüşmeleri toplama işlemine ve ortalama alma işlemine dahil olmasın istemekteyim. Biraz kendim yapayım dedim ama senin yazdığın kodları dahada karıştırdığımı gördüm senden yardım rica ederim.

 

[Muzaffer Ali]

Aşağıdaki kodları deneyin.

Sub btnRapor_Click()
    Dim Bak As Range
    Dim Say As Long
    Dim Saat As String
    Dim Dakika As String
    Dim Saniye As String
    Dim Alan As Range
    Say = Cells(Rows.Count, "A").End(3).Row
    Range("B3:I" & Cells(Rows.Count, "A").End(3).Row).ClearContents
    With Worksheets("Veri")
        For Each Bak In Range("A3:A" & Say)
            Bak(1, 2).Value = WorksheetFunction.CountIfs(.Range("K:K"), Bak, .Range("F:F"), ">0.00069")
            Bak(1, 3).Value = WorksheetFunction.SumIfs(.Range("F:F"), .Range("K:K"), Bak, .Range("F:F"), ">0.00069")
            If Bak(1, 3).Value = 0 Or Bak(1, 2).Value = 0 Then
                Bak(1, 4).Value = 0
            Else
                Bak(1, 4).Value = Bak(1, 3).Value / Bak(1, 2).Value
            End If
            Bak(1, 5).Value = WorksheetFunction.CountIfs(.Range("K:K"), Bak, .Range("AE:AE"), "Cevapsız")
            Bak(1, 6).Value = WorksheetFunction.CountIfs(.Range("K:K"), Bak, .Range("AE:AE"), "Reddetme")
            Bak(1, 7).Value = WorksheetFunction.CountIfs(.Range("P:P"), Bak, .Range("F:F"), ">0.00069")
            Bak(1, 8).Value = WorksheetFunction.SumIfs(.Range("F:F"), .Range("P:P"), Bak, .Range("F:F"), ">0.00069")
            If Bak(1, 7).Value = 0 Or Bak(1, 8).Value = 0 Then
                Bak(1, 9).Value = 0
            Else
                Bak(1, 9).Value = Bak(1, 7).Value / Bak(1, 8).Value
            End If
        Next
        Set Alan = Range("C3:C" & Say & ", H3:H" & Say)
        For Each Bak In Alan
            Saat = IIf(Len(Int(Bak * 24)) = 1, "0" & Int(Bak * 24), Int(Bak * 24))
            Dakika = IIf(Len(Minute(Bak)) = 1, "0" & Minute(Bak), Minute(Bak))
            Saniye = IIf(Len(Second(Bak)) = 1, "0" & Second(Bak), Second(Bak))
            Bak.Value = "'" & Saat & ":" & Dakika & ":" & Saniye
        Next
    End With
End Sub

 

[tcilek]

Üstad kodları çalıştırdım dış arama çağrı ortalama süreleri kısmında bir hata var ortalama almıyor gibi durmakta

 

[Muzaffer Ali]

Evet şu satırdaki sıralamayı yanlış yazmışım.
Bak(1, 9).Value = Bak(1, 7).Value / Bak(1, 8).Value

yedi ile sekizin yerleri değişmesi gerekiyor.
Satır aşağıdaki gibi olmalı.
Bak(1, 9).Value = Bak(1, 8).Value / Bak(1, 7).Value

 

[tcilek]

Ellerine sağlık üstadım harikulade çalışıyor teşekkür ederim.

 

[tcilek]

Dalgalıkur üstadım bu kodlarda dakikayı nerede belirttin olurda değiştirmem gerektiği zaman kodlarını bozmadan değiştireyim.