Bölünerek kayıt altına alınan faturanın tek şekilde listelenmesi.

[fledermaus]

Emir Bey Merhaba ,

Bakabildiniz mi ?

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With
    
    Dim SD As Worksheet: Set SD = Sheets("Cost Data")
    Dim SO As Worksheet: Set SO = Sheets("Invoice List")
    SO.Select
    Dim dic As Object, liste(), dizi()
    
    son = SD.Cells(Rows.Count, "L").End(3).Row
    liste = SD.Range("B9:AG" & son).Value
    
    ReDim dizi(1 To son, 1 To 32)
    
    Set dic = CreateObject("scripting.dictionary")
    
    For x = 1 To UBound(liste, 1)
        
        aranan = liste(x, 11) & "#" & liste(x, 12)
        If aranan <> "#" Then
            If Not dic.exists(aranan) Then
                n = n + 1
                dic.Add aranan, n
                ReDim Preserve dizi(1 To son, 1 To 32)
                
                dizi(n, 1) = liste(x, 1)
                
                dizi(n, 2) = liste(x, 11)
                dizi(n, 3) = liste(x, 13)
                dizi(n, 4) = liste(x, 12)
                dizi(n, 5) = liste(x, 15)
                
                dizi(n, 9) = liste(x, 26)
                dizi(n, 11) = liste(x, 27)
            End If
            
            dizi(dic.Item(aranan), 6) = dizi(dic.Item(aranan), 6) + liste(x, 22)
            dizi(dic.Item(aranan), 7) = dizi(dic.Item(aranan), 7) + liste(x, 23)
            dizi(dic.Item(aranan), 8) = dizi(dic.Item(aranan), 8) + liste(x, 24)
            dizi(dic.Item(aranan), 9) = dizi(dic.Item(aranan), 9) + liste(x, 25)
            dizi(dic.Item(aranan), 10) = dizi(dic.Item(aranan), 10) + liste(x, 26)
            dizi(dic.Item(aranan), 12) = dizi(dic.Item(aranan), 12) + liste(x, 28)
        End If
    Next x
    
    SO.Range("A10:M" & Rows.Count).ClearContents
    SO.Range("B10").Resize(dic.Count, 12) = dizi
    
    son = SO.Cells(Rows.Count, "B").End(3).Row
    SO.Cells(son + 1, "B") = "Totals"
    SO.Cells(son + 1, "M").Formula = "=sum(m10:m" & son & ")"
    
    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    
End Sub

. . .

 

[fledermaus]

Emir Bey Merhaba,

Vermiş olduğunuz kodu uyguladım ancak "J" sütunu veri tabanına göre "Z" sütunu yanlış veri veriyor ve başlığı birşeyle karışıyor. Bunun dışında, yeni veri girildiğinde listenin en altında toplam kısmına ait koşullu biçilendirmede şeklinde gürünüyor. Yardımlarınızı rica ediyorum. Tablo ekteki gibidir.

 

[fledermaus]

Aslında kod içinde hangi itemları nasıl değiştirmem konusunda bilgi verirseniz kendim uğraşıp düzeltebilmek istiyorum. tşk,

 

[fledermaus]

Emir Bey,

Yardımcı olabilecek misiniz ?

 

[fledermaus]

Emir Bey,

Bakabildiniz mi?

 

[Emir Hüseyin Çoban]

. . .

Şu satırı silerek deneyiniz.

dizi(n, 9) = liste(x, 26)

. . .

 

[fledermaus]

Emir Bey,

Söylemiş olduğunuz gibi kodu revize ettim. Herhangi bir sorun yok. Ancak yeni veri girildiğinde son satırda yer alan genel toplama karışıyor. Bunu düzeltmek için ne yapmalıyım ? Yardımcı olabilecekmisniz ? Tşk,

 

[Emir Hüseyin Çoban]

. . .

Karışıyor derken... ne olduğunu anlayamadım.

. . .

 

[fledermaus]

Emir Bey,

Burda yazacaklarım kafa karıştırıcı olabilir. Bu yüzden bir önceki mesajımda gönderdiğim dosyada ilgili sayfada en alt toplamı incelerseniz daha iyi izah etmiş olacağım. Tşk,

 

[Emir Hüseyin Çoban]

. . .

Invoice List sayfasında koşullu biçimlendirmeyi 1000 satırlık yapın.

Sub kod()
    
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
    End With
    
    Dim SD As Worksheet: Set SD = Sheets("Cost Data")
    Dim SO As Worksheet: Set SO = Sheets("Invoice List")
    SO.Select
    Dim dic As Object, liste(), dizi()
    
    son = SD.Cells(Rows.Count, "L").End(3).Row
    liste = SD.Range("B9:AG" & son).Value
    
    ReDim dizi(1 To son, 1 To 32)
    
    Set dic = CreateObject("scripting.dictionary")
    
    For x = 1 To UBound(liste, 1)
        
        aranan = liste(x, 11) & "#" & liste(x, 12)
        If aranan <> "#" Then
            If Not dic.exists(aranan) Then
                n = n + 1
                dic.Add aranan, n
                ReDim Preserve dizi(1 To son, 1 To 32)
                
                dizi(n, 1) = liste(x, 1)
                
                dizi(n, 2) = liste(x, 11)
                dizi(n, 3) = liste(x, 13)
                dizi(n, 4) = liste(x, 12)
                dizi(n, 5) = liste(x, 15)
                dizi(n, 11) = liste(x, 27)
            End If
            
            dizi(dic.Item(aranan), 6) = dizi(dic.Item(aranan), 6) + liste(x, 22)
            dizi(dic.Item(aranan), 7) = dizi(dic.Item(aranan), 7) + liste(x, 23)
            dizi(dic.Item(aranan), 8) = dizi(dic.Item(aranan), 8) + liste(x, 24)
            dizi(dic.Item(aranan), 9) = dizi(dic.Item(aranan), 9) + liste(x, 25)
            dizi(dic.Item(aranan), 10) = dizi(dic.Item(aranan), 10) + liste(x, 26)
            dizi(dic.Item(aranan), 12) = dizi(dic.Item(aranan), 12) + liste(x, 28)
        End If
    Next x
    
    SO.Range("A10:M" & Rows.Count).ClearContents
    SO.Range("B10").Resize(dic.Count, 12) = dizi
    
    son = SO.Cells(Rows.Count, "E").End(3).Row
    SO.Cells(son + 1, "B") = "Totals"
    SO.Cells(son + 1, "M").Formula = "=sum(m10:m" & son & ")"
    
    With Application
        .ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .EnableEvents = True
    End With
    
End Sub

. . .

 

[fledermaus]

Emir Bey,

Yardımlarınız için gerçekten çok teşekkür ederim. Bu arada size birşey danışmak istiyorum. Excelde oluşturdğumuz herhangi bir pivot tablonun kodunu kopyalayıp macro olarak kullanma imkanı varmıdır ? Daha önce hiç denemedim ya da duymadım ancak böyle birşeyin olabiliritesi nedir ? Bilginiz var mıdır ?

Syg,

 

[Emir Hüseyin Çoban]

. . .

Makro kaydet ile belirli bir yere kadar özet tablonun kodlarını oluşturabilirsiniz.

Özet tablo kodlarıyla Sy. Korhan Ayhan' nın paylaşımları vardı. Forumda aratınız.

. . .