Keresés

Új hozzászólás Aktív témák

  • Delila_1

    veterán

    válasz kokopeti #15509 üzenetére

    A 'Napi összesítő' lap A2 cellája a mód, B2 a bruttó, C2 a nettó, D2 a megjegyzés.

    A laphoz rendeld ezt a makrót:

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim datum As Date
    If Target.Address = "$A$1" Then
    Application.EnableEvents = False
    datum = Target.Value
    Osszevonas datum
    Application.EnableEvents = True
    End If
    End Sub

    Modulba tedd a másikat:

    Sub Osszevonas(datum)
    Dim sor%, usor%, usorN%, f As Boolean
    Application.ScreenUpdating = False
    Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
    Set WS1 = Worksheets("Kiadások")
    Set WS2 = Worksheets("Bevételek")
    Set WS3 = Worksheets("Napi összesítő")

    WS1.Select
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    usorN% = 2
    For sor% = 2 To usor%
    If Cells(sor%, 1) = datum Then
    usorN% = usorN% + 1
    f = True
    WS3.Cells(usorN%, 1) = Cells(sor%, 2)
    WS3.Cells(usorN%, 2) = Cells(sor%, 3) * -1
    WS3.Cells(usorN%, 3) = WS3.Cells(usorN%, 2) / 1.27
    WS3.Cells(usorN%, 4) = Cells(sor%, 5)
    End If
    Next

    WS2.Select
    usor% = Cells(Rows.Count, "A").End(xlUp).Row
    For sor% = 2 To usor%
    If Cells(sor%, 1) = datum Then
    f = True
    usorN% = usorN% + 1
    WS3.Cells(usorN%, 1) = Cells(sor%, 2)
    WS3.Cells(usorN%, 2) = Cells(sor%, 3)
    WS3.Cells(usorN%, 3) = WS3.Cells(usorN%, 2) / 1.27
    WS3.Cells(usorN%, 4) = Cells(sor%, 4)
    End If
    Next

    WS3.Select
    Application.ScreenUpdating = True

    If f = False Then MsgBox "Nincs mozgás a " & datum & " napon."
    End Sub

    Az összes bruttót az =szum(B:B), az összes nettót az =szum(D:D) képlet számolja ki a harmadik lapodon.

Új hozzászólás Aktív témák