-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Fferi50
őstag
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
- Android alkalmazások - szoftver kibeszélő topik
- Robot fűnyírók
- Politika
- AMD Navi Radeon™ RX 7xxx sorozat
- A fociról könnyedén, egy baráti társaságban
- Kertészet, mezőgazdaság topik
- Google Pixel 8 Pro - mestersége(s) az intelligencia
- Mozilla Firefox
- Milyen légkondit a lakásba?
- OFF TOPIC 44 - Te mondd, hogy offtopic, a te hangod mélyebb!
- További aktív témák...
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Steames kulcsok jó áron eladóak!
- Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!