Több tábla összefésülése/összehasonlítása

Szia!

Hát enyhén szólva nem egyértelmű a feladat, de homályosan sejthető. Amit sejtek:

Részletfizetésről van szó?
Van egy számla egy eredeti összegről, és azt törleszti, így minden befizetéskor csökken a tartozása?
Emiatt a számlaszám minden befizetéskor ugyanaz?

Ha ajó a modell, akkor ez megcsinálható viszonylag egyszerűen.
Pl. Az eredeti, teljes összeg pozitív, a befizetés negatív értékekkel, akkor egy sima összesítés számlaszámonként

Bárhoyg is, az eredeti összegnek meg kell lennie egy számlához, és a hozzá tartozó befizetéseket is azonosítani kell, és kapcsolnio az eredeti számlához.
A befizető is a számlához tartozik egyértelműen, de a számla azonosító fontosabb.

Kb ilyesmire gondolok, de minta nélkül nem tudok tovább menni.

Imre

Szia!

Írtam egy makrót, ami elkészíti az összesítést.
A csatolt füzetben az Osszesites makrót kell indítanod.

Üdv,
Delila

Nem tudom, miért nincsenek ott a makrók. Bemásolom ide.
Alt+F11-re bejön a VB szerkesztő. Bal oldalon kiválasztod a füzetedet (ha van több is megnyitva), az Insert-Module kiválasztására kapsz egy új modult bal oldalon, Module1 névvel. A jobb oldali nagy üres mezőbe másold be ezeket:

Sub Osszesites()
    Dim lap As Integer, uoszlop As Integer, usorR As Long, lapnev As String
    Sheets("Riport_2").Cells.Delete
    Sheets(2).Range("A1:E1").Copy Sheets("Riport_2").Range("A1")
    
    For lap = 2 To Worksheets.Count
        If Left(Sheets(lap).Name, 6) <> "Riport" Then
            uoszlop = Sheets("Riport_2").Cells(1, Columns.Count).End(xlToLeft).Column + 1
            usorR = Sheets("Riport_2").Range("A" & Rows.Count).End(xlUp).Row + 1
            With Sheets(lap)
                Sheets(1).Cells(1, uoszlop) = "Hátralék " & .Name
                usor = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2:E" & usor).Copy Sheets(1).Range("A" & usorR)
                .Range("F2:F" & usor).Copy Sheets(1).Cells(usorR, uoszlop)
            End With
        End If
    Next
    Rendez uoszlop
End Sub

Sub Rendez(uoszlop)
    Sheets("Riport_2").Select
    usor = Range("A" & Rows.Count).End(xlUp).Row
    
    ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("B1:B" & usor), _
        SortOn:=xlSortOnValues, Order:=xlAscending
    ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("D1:D" & usor), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("A1:A" & usor), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Riport_2").Sort
        .SetRange Range(Cells(2, 1), Cells(usor, uoszlop))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Egyesites uoszlop
End Sub

Sub Egyesites(uoszlop)
    Dim oszlop As Integer
    
    Sheets("Riport_2").Select
    usor = Range("A" & Rows.Count).End(xlUp).Row
    uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For sor = usor To 3 Step -1
        If Cells(sor, 1) = Cells(sor - 1, 1) And Cells(sor, 2) = Cells(sor - 1, 2) _
            And Cells(sor, 4) = Cells(sor - 1, 4) Then
            For oszlop = 6 To uoszlop
                Cells(sor - 1, oszlop) = Cells(sor, oszlop) + Cells(sor - 1, oszlop)
            Next
            Rows(sor).Delete
        End If
    Next
    
    Cells.EntireColumn.AutoFit
End Sub

A felsőt kell indítanod, az meghívja a másik kettőt.

Indítod a makrót. Mikor leáll a hibaüzenettel, Alt+F11-gyel belépsz a VB szerkesztőbe. A kurzort a hibás sorban (sárga hátterű) a sor változó fölé viszed, ami megmutatja a hibás sor számát. Azzal már tudsz valamit kezdeni. Leállítod a makrót (az eszköztáron a négyszögletes stop gombbal), majd a füzetben a Riport_2 lapon kikeresed azt a sort.
El tudom képzelni, hogy valamelyik hónapban az összeg nem szám, hanem számnak látszó szöveg.

Vagy: tömöríted a fájlodat, és beteszed ide.