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

  • T.Lacci
    csendes tag

    Sub Szorzas()
    Dim sor As Long, usor As Long, szorzo As Single

    'Alsó sor meghatározása a D oszlopban)
    usor = Range("D" & Rows.Count).End(xlUp).Row

    'Ciklus az elsőtől az utolsó sorig
    For sor = 1 To usor
    'Feltételek megdása
    Select Case Cells(sor, "D")
    Case 1 To 10000
    szorzo = 1.4
    Case 10001 To 20000
    szorzo = 1.3
    Case 20001 To 30000
    szorzo = 1.2
    Case Else
    szorzo = 0.9
    End Select

    'Szorzat beírása az E oszlopba
    Cells(sor, "E") = Cells(sor, "D") * szorzo

    'Ha kerekítve akarod megadni a szorzatot, a fenti helyett
    'a lenti sort alkalmazd a szorzásra
    'Cells(sor, "E") = Round(Cells(sor, "D") * szorzo, 0)
    Next
    End Sub

    A Case sorokat folytathatod. A Case Else sorhoz azt az utasítást add, ami azokra az összegekre vonatkozik, amikhez a fölötte lévő feltételekben nem határoztál meg szorzót. Ki is hagyható.
    Figyelj, hogy a szorzók tizedes ponttal, nem veszővel írandók a makróban!

    Köszönöm a segítségedet, máris kipróbálom

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