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

• #42034 Fferi50 Topikgazda #73966957 #42033

  Új Válasz 2019-10-30 14:56:33 #42034

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fferi50

  Topikgazda

  válasz #73966957 #42033 üzenetére

  Szia!
  Bocs, a 100-ast valóban elnéztem.
  A makrót megváltoztattam, annyi a megkötés, hogy 3 komponensnek kell lennie és az M-R oszlopokban legyenek az adatok, ahogyan a képen mutattam: név, mellette az ár. Lehetnek különböző hosszúságúak.
  Az alapár az L2 cellában legyen.
  A makró többször is futtatható, az előző futás eredményét törli.
  Sub varial()
Dim aras(), u As Integer, usor1 As Integer, usor2 As Integer, usor3 As Integer, alap As Double
Dim x As Byte, y As Byte, z As Byte
Application.ScreenUpdating = False
u = 2
usor1 = Range("M2").End(xlDown).Row
usor2 = Range("O2").End(xlDown).Row - 1
usor3 = Range("Q2").End(xlDown).Row - 1
aras = Range("M2:R" & usor1).Value
If Range("A2") <> "" Then Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).ClearContents
alap = Range("L2").Value
For x = 1 To usor1 - 1
    For y = 1 To usor2
        For z = 1 To usor3
            Cells(u, 1).Value = alap: Cells(u, 2).Value = aras(x, 1): Cells(u, 3).Value = aras(x, 2): Cells(u, 4).Value = aras(y, 3): Cells(u, 5).Value = aras(y, 4): Cells(u, 6).Value = aras(z, 5): Cells(u, 7).Value = aras(z, 6)
            Cells(u, 8).Value = alap + aras(x, 2) + aras(y, 4) + aras(z, 6)
            u = u + 1
        Next
    Next
    DoEvents
Next
Application.ScreenUpdating = True
MsgBox "Készen vagyok!"
End Sub
  
  Üdv.

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