İlk Sayfadaki Giderleri, ikinci sayfadaki düzeltmeler ile toplayıp yeni bir sayfaya yazdırma

[HsynAA]

Değerli Forum Hocalarım,

Bir konuda desteğiniz rica ediyorum. 3 sayfadan oluşan bir excel dosyam var 1. sayfasında belirli kodlara ve isimlere göre gelen sırası ve satır uzunluğu her ay değişen giderlerim var ikinci sayfada ise aynı kod ve isimlere göre yaptığım düzeltmeler var , ben istiyorum ki 3 sayfaya bu iki sayfadaki verilerin toplamını getirsin ancak sadece tutar sutununu toplasın diğer veriler aynen gelsin anlatması biraz uzun gibi ama inş anlatabilmişimdir. örnek dosya içinde de yine anlatmaya çalıştım.

bu konuda bana yardımcı olabilir misiniz.

Saygılarımla, Forumda emeği geçen tüm arkadaşlarıma teşekkür ediyorum.

 

[çıtır]

Dosyanız.

 

[HsynAA]

Dosyanız.

İlginiz için teşekkür ediyorum Çıtır Hanım, ana sayfadaki diğer veriler gelmiyor. sadece düzeltmelerin olduğu sayfayadaki veriler geliyor. ben istiyorum ki ana sayfadaki veriler + düzeltmeler = hepsi 3. sayfaya yazsın

 

[veyselemre]

Sub test()
    lst1 = Sheets("Ana Sayfa").Range("a3:K" & Sheets("Ana Sayfa").Cells(Rows.Count, 1).End(3).Row).Value
    lst2 = Sheets("Düzeltmeler").Range("a3:K" & Sheets("Düzeltmeler").Cells(Rows.Count, 1).End(3).Row).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(lst1)
            ky = Join(Application.Index(lst1, i, [{1,2,3,4,5,6,7,8,9,10}]), "|")
            If Not .exists(ky) Then
                .Item(ky) = i
            Else
                lst1(.Item(ky), 11) = lst1(.Item(ky), 11) + lst1(i, 11)
            End If
        Next i
        For i = 1 To UBound(lst2)
            ky = Join(Application.Index(lst2, i, [{1,2,3,4,5,6,7,8,9,10}]), "|")
            lst1(.Item(ky), 11) = lst1(.Item(ky), 11) + lst2(i, 11)
        Next i
        Sheets("Son Hali").Range("a3:K" & Rows.Count).ClearContents
        ylst = Application.Transpose(Application.Index(lst1, .items, [row(1:11)]))
        Sheets("Son Hali").Range("a3").Resize(UBound(ylst), 11).Value = ylst
    End With
End Sub

 

[veyselemre]

Sub adoBirlestir()
    Set adoCN = CreateObject("ADODB.Connection")
    adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCN.Properties("Data Source") = ThisWorkbook.FullName
    adoCN.Properties("Extended Properties") = "Excel 8.0; HDR=No;"
    adoCN.Open
    Set rs = CreateObject("Adodb.RecordSet")

    strsql = "SELECT F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, Sum(F11) AS ToplaTutar " & _
             "FROM " & _
             "( " & _
             "  SELECT * FROM [Ana Sayfa$A3:K" & Sheets("Ana Sayfa").Cells(Rows.Count, 1).End(3).Row & "] " & _
             "    UNION " & _
             "  SELECT  * FROM [Düzeltmeler$A3:K" & Sheets("Düzeltmeler").Cells(Rows.Count, 1).End(3).Row & "] " & _
             ") " & _
             "GROUP BY F1, F2, F3, F4, F5, F6, F7, F8, F9, F10"

    rs.Open strsql, adoCN, 1, 1

    Sheets("Son Hali").Range("a3:K" & Rows.Count).ClearContents
    Sheets("Son Hali").Range("a3").CopyFromRecordset rs
    rs.Close
    adoCN.Close
    Set rs = Nothing
    Set adoCN = Nothing
End Sub

 

[HsynAA]

Sub adoBirlestir()
    Set adoCN = CreateObject("ADODB.Connection")
    adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCN.Properties("Data Source") = ThisWorkbook.FullName
    adoCN.Properties("Extended Properties") = "Excel 8.0; HDR=No;"
    adoCN.Open
    Set rs = CreateObject("Adodb.RecordSet")

    strsql = "SELECT F1, F2, F3, F4, F5, F6, F7, F8, F9, F10, Sum(F11) AS ToplaTutar " & _
             "FROM " & _
             "( " & _
             "  SELECT * FROM [Ana Sayfa$A3:K" & Sheets("Ana Sayfa").Cells(Rows.Count, 1).End(3).Row & "] " & _
             "    UNION " & _
             "  SELECT  * FROM [Düzeltmeler$A3:K" & Sheets("Düzeltmeler").Cells(Rows.Count, 1).End(3).Row & "] " & _
             ") " & _
             "GROUP BY F1, F2, F3, F4, F5, F6, F7, F8, F9, F10"

    rs.Open strsql, adoCN, 1, 1

    Sheets("Son Hali").Range("a3:K" & Rows.Count).ClearContents
    Sheets("Son Hali").Range("a3").CopyFromRecordset rs
    rs.Close
    adoCN.Close
    Set rs = Nothing
    Set adoCN = Nothing
End Sub

Veysel Bey ilginiz için teşekkür ediyorum ama ben bu kod işinden pek anlamıyorum abi ya nasıl yapılır ne edilir pek bilmem bunu formüller ile yapamaz mıyım ?

 

[Korhan Ayhan]

Formülle çözüm dosyasını inceleyiniz. Pratik olması açısından yardımcı sütun kullanılmıştır.

Yardımcı sütunları gruplandırma uygulayarak gizledim. Açıp inceleyebilirsiniz.

 

[Ömer BARAN]

Merhaba.
Özel mesaj ile formüllü çözüm konusunda destek rica edilmiş olduğundan ilave açıklamalar da yazarak hazırladığım dosyayı ekleyeyim dedim.

Ekteki belgede yer alan açıklama, formül ve AD TANIMLAMALARINI inceleyiniz.
.

 

[HsynAA]

Formülle çözüm dosyasını inceleyiniz. Pratik olması açısından yardımcı sütun kullanılmıştır.

Yardımcı sütunları gruplandırma uygulayarak gizledim. Açıp inceleyebilirsiniz.

Tam aradığım cevap hocam Allah razı olsun eksik olmayın

 

[HsynAA]

Formülle çözüm dosyasını inceleyiniz. Pratik olması açısından yardımcı sütun kullanılmıştır.

Yardımcı sütunları gruplandırma uygulayarak gizledim. Açıp inceleyebilirsiniz.

Korhan Bey ilginize ve alakanıza çok teşekkür ediyorum İyi ki varsınız, Hem sizin hemde Ömer beyin verdiği cevaplar işimi fazlasıyla görüyor çok saolun.

 

[veyselemre]

Korhan Beyin çalışması tam sonuçları vermemiş,

 

[Korhan Ayhan]

Veysel Bey,

Uyarınız üzerine eklediğim dosyayı tekrar inceledim. Sıralama numarası üreten maksimum formülünü sabitlemediğim için sorun oluşmuş. Gerekli düzeltme yapılmıştır.