Hirdetés
- sziku69: Szólánc.
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- Gurulunk, WAZE?!
- potyautas: A Magyar Néphadsereg emlékére
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- bambano: Bambanő háza tája
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- gban: Ingyen kellene, de tegnapra
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
-
LOGOUT
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
-
Mutt
senior tag
válasz
#73966957
#42028
üzenetére
Szia,
... Hogyan tudnék excelben létrehozni egy olyan munkafüzetet, ahol ha megadom, hogy pl. 100.000 Ft az alapára a kerékpárnak, majd pedig megadom a 3*10db opciót árakkal, akkor az excel kiszámolja nekem az összes létező variációt, tehát mind a 1.000db-ot és mondjuk egymás alá megadja nekem egy táblázatban.
Makrómentesen az Excel 2010-től elérhető Power Query tud segíteni.
1. A különböző opciókat táblázattá alakítsd át, FFeri mintáját felhasználva van 4 táblázatom egymás mellett. Az elsőben csak a kerékpár alapára van, a többiben pedig a választható elemek (eltérő színekkel jelöltem ezeket). Mindegyik táblázatnak adjál egy beszédes nevet (én Alap, Vaz, Gumi, Attetel, Szin-t használtam).

2. Ezeket az adatokat Power Query-be kell tölteni, rajta állsz az adott adatsoron és Adatok -> Beolvasás táblázat/tartományból.

3. Nem kell semmit Power Query-ben még csinálni, csak Adatok betöltése adott helyre opciót választani és Csak kapcsolatot megadni.
A 2-3-as lépéseket meg kell csinálni mindegyik adatsorral, vagyis lesz 5 db Power Query kapcsolatunk a fájlunkban. Adatok -> Lekérdezések és Kapcsolatok alatt lehet őket látni.

4. Jobb klikk az Alap lekérdezésen a kapcsolatok lapon és Referencia/Hivatkozást választva visszajutunk a Power Query-be, ahol a egy új Egyéni oszlopot kell felvenni.

5. Az egyéni oszlop képlete csak a másik táblának a neve (pl. Vaz).

6. Az új oszlop jobb felső sarkában lévő ikonra kattintva ki lehet bontani az adatokat.

Az eredmény egy keresztszorzat lesz:

7. Az 5-6-os lépéseket végezd el a többi választható opciókat tartamazó adatsorokkal.
A végén vmi hasonlót kapsz:
8. Egy újabb egyéni oszlopban már csak a különböző változatok teljes árát kell kiszámolni, ami egy sima összeadás.

9. Az eredményt vissza kell tölteni Excelbe, a Bezárás és betöltés opcióval.
üdv
-
Fferi50
Topikgazda
válasz
#73966957
#42039
üzenetére
Szia!
Az alábbi makrókat együtt kell bemásolnod egy modulba. Igyekeztem általánossá tenni.
Az alkotó elemeket az O oszloptól lehet beírnod. Az első oszlop 2. cellája az alapár.
A többi oszlop tartalmazza a megnevezést és az árakat párban. A makró a P2 cellából indul ki (de ez nem azt jelenti, hogy ide kell az alapárat írnod), ez legyen mindenképpen a kiindulási területen. A fejléceket nem másolja. Az utolsó oszlopba kerül az összár.
Most lehet 2-3-4 sőt akár 5 összetevője is az összárnak. Persze vedd figyelembe, hogy minél több a változat, annál több lesz a variáció és nő a futási idő is. Ha már unod, akkor a Ctrl+ Break megszakítja a futást, erre két helyen figyel a makró - ott ahol DoEvents van.
A varialhat makrót kell elindítanod, a másikat majd az meghívja, ha kell neki. Íme:Sub varialhat()Dim u As Integer, alap As DoubleDim x As Long, y As Long, kepl As StringDim arazas As Range, oszl As RangeDim oszlopok As New CollectionDim varia As LongDim oszlsz As IntegerDim valami(), szoroz As LongSet arazas = Range("P2").CurrentRegionalap = arazas.Cells(2, 1).Value: kepl = "=A2"varia = 1For x = 2 To arazas.Columns.CountWith arazas.Columns(x)oszlopok.Add Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)), Str(x - 1)If x Mod 2 = 0 Then varia = varia * oszlopok(x - 1).Cells.Count: kepl = kepl & "+" & Cells(2, x + 1).Address(rowabsolute:=False)End WithDoEventsNextoszlsz = oszlopok.CountApplication.ScreenUpdating = FalseIf Range("A2") <> "" Then Range(Range("A2"), Cells(Range("A2").End(xlDown).Row, Range("A2").End(xlToRight).Column)).ClearContentsu = 2Range(Cells(u, 1), Cells(u + varia - 1, 1)).Value = alapy = 2ReDim Preserve valami(1 To varia, 1 To oszlsz)szoroz = 1For x = oszlsz To 1 Step -1sokszoroz oszlopok(x), x, szoroz, varia / oszlopok(x).Cells.Count / szoroz, valami'oszl.Copy Destination:=Cells(u, y)'Range(Cells(u, y), Cells(u + oszl.Cells.Count - 1, y)).AutoFill Destination:=Range(Cells(u, y), Cells(varia + 1, y)), Type:=xlFillCopyIf x Mod 2 = 1 Then szoroz = szoroz * oszlopok(x).Cells.CountNexty = 2 + oszlszRange(Range("B2"), Cells(UBound(valami, 1) + 1, y - 1)).Value = valamiRange(Cells(u, y), Cells(u + varia - 1, y)).Formula = keplRange(Cells(u, y), Cells(u + varia - 1, y)).Value = Range(Cells(u, y), Cells(u + varia - 1, y)).ValueApplication.ScreenUpdating = TrueRange("A1").SelectMsgBox "Készen vagyok!"End SubSub sokszoroz(ByRef mit, hova, hanyszor, ciklus, ByRef valami())Dim x As Long, cl As Range, w As Integer, z As Longx = 1For z = 1 To ciklusFor Each cl In mit.CellsFor w = 1 To hanyszorvalami(x, hova) = cl.Valuex = x + 1NextNextDoEventsNextEnd SubHa bármi probléma adódik, csak írj.
Üdv. -
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 DoubleDim x As Byte, y As Byte, z As ByteApplication.ScreenUpdating = Falseu = 2usor1 = Range("M2").End(xlDown).Rowusor2 = Range("O2").End(xlDown).Row - 1usor3 = Range("Q2").End(xlDown).Row - 1aras = Range("M2:R" & usor1).ValueIf Range("A2") <> "" Then Range(Range("A2"), Range("A2").End(xlToRight).End(xlDown)).ClearContentsalap = Range("L2").ValueFor x = 1 To usor1 - 1For y = 1 To usor2For z = 1 To usor3Cells(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 + 1NextNextDoEventsNextApplication.ScreenUpdating = TrueMsgBox "Készen vagyok!"End Sub
Üdv. -
Fferi50
Topikgazda
válasz
#73966957
#42028
üzenetére
Szia!
Egy makróval megoldható a feladat. Az árlistát az alábbiak szerint helyezd el:
Az L2 cella tartalmazza az alapárat, az M, O, Q oszlopok a tartozékfajták megnevezését, a mellettük levő oszlop pedig az árakat.
Az árlista generálása az A2 cellától kezdődik és tartalmazza az adott tartozék nevét és árát valamint a végösszeget. A fejléceket nem írja ki a makró, amely az alábbi:Sub varial()Dim aras(), u As Integer, usor As IntegerDim x As Byte, y As Byte, z As Byteu = 2usor = Range("M2").End(xlDown).Rowaras = Range("M2:R" & usor).ValueFor x = 1 To UBound(aras, 1)For y = 1 To UBound(aras, 1)For z = 1 To UBound(aras, 1)Cells(u, 1).Value = 100: 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 = 100 + aras(x, 2) + aras(y, 4) + aras(z, 6)u = u + 1NextNextNextEnd Sub
Ezt a makrót egy modullapra helyezd el. (eljárás az összefoglalóban).
3 fajta összetevőt használhatsz, de ezen belül nem csak 10-10 lehetőséget, azokat tetszés szerint növelheted. Fontos, hogy azokat azM : Roszlopokba írd.Üdv.
Új hozzászólás Aktív témák
- Xiaomi Redmi Note 13 256GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRGARANCIA!Épített KomPhone i5 14400F 32/64GB DDR5 RTX 5060 Ti 8GB GAMER PC termékbeszámítással
- BESZÁMÍTÁS! Apple Watch Ultra 2 49mm Cellular okosóra garanciával hibátlan működéssel
- Bontatlan iPhone 16 (256 GB) (rendelhető)
- Apple Watch Ultra, Újszerű,Dobozával, 12 hónap garanciával
Állásajánlatok
Cég: ATW Internet Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi

Fferi50
