Aynı Vergi Numaralı Hücreleri ve Değerleri Başka Sayfada Birleştirme

[anilman]

Merhaba, ekteki dosyada yapmak istediğim Makro Kod yardımıyla İND Sayfasındaki listede Tutanak sütunu dolu olup ve aynı vergi numaraya sahip firmaları, TUTANAK TABLOSU sayfasındaki örnek gibi firma adını yerleştirip yine Tutanak sütunundaki KDV'leri de toplamasını, Eğer İND sayfasında AÇIKLAMA sütununda 'ÖNCEKİ DÖNEM' metni var ise TUTANAK TABLOSU sayfasında bir alt satıra ayrı bir şekilde yazılsın istiyorum. Yardımlarınızı bekliyorum.

 

[veyselemre]

Sub test()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i&, son&, sat&, islSat&, ky$

    Set s1 = Sheets("İND")
    Set s2 = Sheets("TUTANAK TABLOSU")
    s2.Range("B3:D17").ClearContents
    sat = 3

    With CreateObject("Scripting.Dictionary")
        son = s1.Cells(Rows.Count, 7).End(3).Row
        If son > 4 Then
            For i = 5 To son
                If s1.Cells(i, "O").Value > 0 Then
                    ky = s1.Cells(i, "G").Value
                    If s1.Cells(i, "B").Value = "ÖNCEKİ DÖNEM" Then
                        ky = ky & "-x"
                    End If
                    If Not .exists(ky) Then
                        .Item(ky) = sat
                        s2.Cells(sat, "B").Value = s1.Cells(i, "F").Value
                        If s1.Cells(i, "B").Value = "ÖNCEKİ DÖNEM" Then
                            s2.Cells(sat, "C").Value = "ONC"
                        Else
                            s2.Cells(sat, "C").Value = Format(s1.Cells(i, "C").Value, "YYYY") & _
                                                       "/" & Format(s1.Cells(i, "C").Value, "MM")
                        End If
                        sat = sat + 1
                    End If
                    islSat = .Item(ky)
                    s2.Cells(islSat, "D").Value = s2.Cells(islSat, "D").Value + s1.Cells(i, "O").Value

                End If
            Next i
        End If
    End With

End Sub

 

[anilman]

Sub test()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i&, son&, sat&, islSat&, ky$

    Set s1 = Sheets("İND")
    Set s2 = Sheets("TUTANAK TABLOSU")
    s2.Range("B3:D17").ClearContents
    sat = 3

    With CreateObject("Scripting.Dictionary")
        son = s1.Cells(Rows.Count, 7).End(3).Row
        If son > 4 Then
            For i = 5 To son
                If s1.Cells(i, "O").Value > 0 Then
                    ky = s1.Cells(i, "G").Value
                    If s1.Cells(i, "B").Value = "ÖNCEKİ DÖNEM" Then
                        ky = ky & "-x"
                    End If
                    If Not .exists(ky) Then
                        .Item(ky) = sat
                        s2.Cells(sat, "B").Value = s1.Cells(i, "F").Value
                        If s1.Cells(i, "B").Value = "ÖNCEKİ DÖNEM" Then
                            s2.Cells(sat, "C").Value = "ONC"
                        Else
                            s2.Cells(sat, "C").Value = Format(s1.Cells(i, "C").Value, "YYYY") & _
                                                       "/" & Format(s1.Cells(i, "C").Value, "MM")
                        End If
                        sat = sat + 1
                    End If
                    islSat = .Item(ky)
                    s2.Cells(islSat, "D").Value = s2.Cells(islSat, "D").Value + s1.Cells(i, "O").Value

                End If
            Next i
        End If
    End With

End Sub

Tam istediğim gibi, çok teşekkürler

 

[assenucler]

Sayın anilman,

Sayın veyselemre'nin kodunu, hangi sayfaya ekliyorsunuz?

Emek ve katkı veren üstat ile bu konuya açan size teşekkürler. Başarılar ve hayırlı kazançlar dilerim.

Saygılar,
Selim

 

[anilman]

Sayın anilman,

Sayın veyselemre'nin kodunu, hangi sayfaya ekliyorsunuz?

Emek ve katkı veren üstat ile bu konuya açan size teşekkürler. Başarılar ve hayırlı kazançlar dilerim.

Saygılar,
Selim

Merhaba
Direk çalışma kitabında yeni bir modül ekledim oraya yapıştırdım.