makro ile özet rapor yapmak

[esahin1907]

hayırlı akşamlar arkadaşlar,
her ay kdv iadesi için hazırlamış olduğumuz rapor var toplamda 130.000 satır veri ile çalışmak zorundayız. buda excel'i kasıyor ve zaman alıyor.verileri data olarak excel'e yükleyip ekteki örneğe uygun olarak makro ile yapabilirmiyiz.
formülle yapmak zaman aldırıyor. konu hakkında fikir verecek dostlar var mı?
şimdiden teşekkürler.

 

[esahin1907]

Yapılabilirmi acaba.

 

[ÖmerBey]

Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.

Sub KOD()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A:D").ClearContents
s2.Range("A:A").NumberFormat = "dd.mm.yyyy"
s1.Range("A2:F65500").Sort Key1:=s1.Range("A2"), Key2:=s1.Range("B2"), Key3:=s1.Range("C2")
For a = 2 To s1.Range("A65500").End(3).Row
    If s1.Cells(a, "A") <> s1.Cells(a - 1, "A") Or s1.Cells(a, "B") <> s1.Cells(a - 1, "B") Or s1.Cells(a, "C") <> s1.Cells(a - 1, "C") Then
        x = x + 1
        s2.Cells(x, "A") = s1.Cells(a, "A")
        s2.Cells(x, "B") = s1.Cells(a, "B")
        s2.Cells(x, "C") = Mid(Split(s1.Cells(a, "C"), "/")(2), 6, 100)
        s2.Cells(x, "D") = WorksheetFunction.SumIfs(s1.Range("E:E"), s1.Range("A:A"), s1.Cells(a, "A"), s1.Range("B:B"), s1.Cells(a, "B"), s1.Range("C:C"), s1.Cells(a, "C"))
    End If
Next
End Sub

 

[isteobenim]

Merhaba,

Sn.mucit77,

Kodlarınız farklı bir çalışmamda benim de işime yaradı.
Teşekkürler,

 

[esahin1907]

mucit77 kod işimi görüyor ayrıca koda tarih ve mağaza toplamlarını da gün gün almasını ekleyebilir miyiz. ben denedim fakat olmadı.

teşekkürler.

 

[Merhum İdris SERDAR]

hayırlı akşamlar arkadaşlar,
her ay kdv iadesi için hazırlamış olduğumuz rapor var toplamda 130.000 satır veri ile çalışmak zorundayız. buda excel'i kasıyor ve zaman alıyor.verileri data olarak excel'e yükleyip ekteki örneğe uygun olarak makro ile yapabilirmiyiz.
formülle yapmak zaman aldırıyor. konu hakkında fikir verecek dostlar var mı?
şimdiden teşekkürler.

.

Amacınız hız ise buyurun.

.

 

[esahin1907]

İdris hocam,
pivot tabloda yapıyorum orada sorun yok fakat aynı fiş numaralarını aynı günleri ve aynı mağazaları birleştirip toplamam almam gerekiyor. Son olarak açıklama kısmındaki mağaza adlarının önünde bulunan rakamları ve tarihleri kaldırıp toplam almak gerekiyor. formülle yapıyorum ancak 130.000 satır olunca excelde kasılmalar başlayıp iş yapma süresi uzamış oluyor. amacım makroda daha kısa zamanda yapmak.

teşekkürler.

 

[esahin1907]

Yardımcı olabilecek var mı??

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

İstediğiniz rapor Sayfa2 isimli sayfaya listelenecektir.

750.000 satırda 6 saniyede sonuç aldım. Sanırım süre sizin için yeterli olacaktır.

Option Explicit

Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, Liste(), Dizi(), Nesne As Object
    Dim X As Long, Say As Long, Kriter As String, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Liste = S1.Range("A2:F" & Son).Value
    
    Set Nesne = CreateObject("Scripting.Dictionary")
    ReDim Dizi(1 To Son, 1 To 4)
    
    For X = 1 To UBound(Liste)
        Kriter = Liste(X, 1) & Liste(X, 2) & Trim(Mid(Liste(X, 3), InStr(1, Liste(X, 3), "/2015 ") + 5, 255))
        If Not Nesne.Exists(Kriter) Then
            Say = Say + 1
            Nesne.Add Kriter, Say
            Dizi(Say, 1) = Liste(X, 1)
            Dizi(Say, 2) = Liste(X, 2)
            Dizi(Say, 3) = Trim(Mid(Liste(X, 3), InStr(1, Liste(X, 3), "/2015 ") + 5, 255))
            Dizi(Say, 4) = Liste(X, 5)
        Else
            Dizi(Nesne.Item(Kriter), 4) = Dizi(Nesne.Item(Kriter), 4) + Liste(X, 5)
        End If
    Next
    
    S2.Range("A2:D" & S2.Rows.Count).ClearContents
    S2.Range("A2:D" & Say) = Dizi
    
    Erase Dizi
    
    Set Nesne = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00000"), vbInformation
End Sub

 

[esahin1907]

Korhan bey merhaba,
kod bu şekilde işimi görüyor süre açısından mükemmel formülle yapacağımız süreyi çok çok aşağı çekmekte . son olarak gün ve mağaza bazında toplam aldırabilirmiyiz.

01.01.2015 xxxx 150,00
02.01.2015 xxxx 100,00
03.01.2015 yyyy 50,00

desteğiniz için teşekkürler.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

"Sayfa3" isimli sayfaya listeleme yapılmaktadır.

Option Explicit

Sub ÖZET_RAPOR_GÜN_VE_MAĞAZA_BAZINDA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, Liste(), Dizi(), Nesne As Object
    Dim X As Long, Say As Long, Kriter As String, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa3")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Liste = S1.Range("A2:F" & Son).Value
    
    Set Nesne = CreateObject("Scripting.Dictionary")
    ReDim Dizi(1 To Son, 1 To 4)
    
    For X = 1 To UBound(Liste)
        Kriter = Liste(X, 1) & Trim(Mid(Liste(X, 3), InStr(1, Liste(X, 3), "/2015 ") + 5, 255))
        If Not Nesne.Exists(Kriter) Then
            Say = Say + 1
            Nesne.Add Kriter, Say
            Dizi(Say, 1) = Liste(X, 1)
            Dizi(Say, 2) = Trim(Mid(Liste(X, 3), InStr(1, Liste(X, 3), "/2015 ") + 5, 255))
            Dizi(Say, 3) = Liste(X, 5)
        Else
            Dizi(Nesne.Item(Kriter), 3) = Dizi(Nesne.Item(Kriter), 3) + Liste(X, 5)
        End If
    Next
    
    S2.Range("A2:C" & S2.Rows.Count).ClearContents
    S2.Range("A2:C" & Say) = Dizi
    
    Erase Dizi
    
    Set Nesne = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00000"), vbInformation
End Sub

 

[esahin1907]

Korhan bey, yardımlarınız için çok teşekkür ederim.