Hirdetés

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

  • Delila_1

    veterán

    válasz Bazs- #37076 üzenetére

    Akkor jön a makró, amit modulba kell bemásolnod.

    Sub Atrendez()
    Dim Innen As Long, Ide As Long, osszeg As Single

    Innen = 2: Ide = 2: osszeg = 0
    Cells(1, 10) = Cells(2, 1) & " " & Cells(2, 2)

    Do While Cells(Innen, 1) <> ""
    If Cells(Innen, 1) & " " & Cells(Innen, 2) = Cells(1, 10) Then

    Cells(Ide, 6) = Cells(Innen, 1)
    Cells(Ide, 7) = "T"
    Cells(Ide, 8) = Cells(Innen, 3)
    osszeg = osszeg + Cells(Innen, 3)
    Else
    Cells(Ide, 6) = Cells(Innen - 1, 2)
    Cells(Ide, 7) = "K"
    Cells(Ide, 8) = osszeg
    Range(Cells(Ide, 6), Cells(Ide, 8)).Font.Bold = True
    Cells(1, 10) = Cells(Innen, 1) & " " & Cells(Innen, 2)
    Innen = Innen - 1
    osszeg = 0
    End If
    Innen = Innen + 1: Ide = Ide + 1
    Loop
    Cells(Ide, 6) = Cells(Innen - 1, 2)
    Cells(Ide, 7) = "K"
    Cells(Ide, 8) = osszeg
    Range(Cells(Ide, 6), Cells(Ide, 8)).Font.Bold = True
    Cells(1, 10) = Cells(Innen, 1) & " " & Cells(Innen, 2)
    End Sub

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