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

• #40384 Delila_1 Topikgazda dav<3 #40383

  Új Válasz 2019-03-07 15:38:09 #40384

  Ú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

  

  Delila_1

  Topikgazda

  válasz dav<3 #40383 üzenetére

  Feltettem ide egy mintafájlt.

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

• #40386 Delila_1 Topikgazda dav<3 #40385

  Új Válasz 2019-03-07 17:54:34 #40386

  Ú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

  

  Delila_1

  Topikgazda

  válasz dav<3 #40385 üzenetére

  Várom a kérdéseket.

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

• #42030 lappy őstag dav<3 #42028

  Új Válasz 2019-10-30 11:59:54 #42030

  Ú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

  

  lappy

  őstag

  válasz dav<3 #42028 üzenetére

  Legördülő lista minden plusz dologhoz és annyi sorban ahány variációban akarod
  De ha szeretnéd az is megoldható bár nem egyszerűen hogy az összes variációt összeallitja majd egy megadott adatbázisból árazás is megtortenik.

  Bámulatos hol tart már a tudomány!

• #42031 Fferi50 őstag dav<3 #42028

  Új Válasz 2019-10-30 12:39:37 #42031

  Ú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

  őstag

  válasz dav<3 #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 Integer
Dim x As Byte, y As Byte, z As Byte
u = 2
usor = Range("M2").End(xlDown).Row
aras = Range("M2:R" & usor).Value
For 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 + 1
        Next
    Next
Next
End 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 az M :  Roszlopokba írd.

  Üdv.

• #42034 Fferi50 őstag dav<3 #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

  őstag

  válasz dav<3 #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.

• #42045 Fferi50 őstag dav<3 #42039

  Új Válasz 2019-10-31 20:57:19 #42045

  Ú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

  őstag

  válasz dav<3 #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 Double
Dim x As Long, y As Long, kepl As String
Dim arazas As Range, oszl As Range
Dim oszlopok As New Collection
Dim varia As Long
Dim oszlsz As Integer
Dim valami(), szoroz As Long
Set arazas = Range("P2").CurrentRegion
alap = arazas.Cells(2, 1).Value: kepl = "=A2"
varia = 1
For x = 2 To arazas.Columns.Count
  With 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 With
  DoEvents
Next
oszlsz = oszlopok.Count
Application.ScreenUpdating = False
If Range("A2") <> "" Then Range(Range("A2"), Cells(Range("A2").End(xlDown).Row, Range("A2").End(xlToRight).Column)).ClearContents
u = 2
Range(Cells(u, 1), Cells(u + varia - 1, 1)).Value = alap
y = 2
ReDim Preserve valami(1 To varia, 1 To oszlsz)
szoroz = 1
For x = oszlsz To 1 Step -1
    sokszoroz 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:=xlFillCopy
    If x Mod 2 = 1 Then szoroz = szoroz * oszlopok(x).Cells.Count
Next
y = 2 + oszlsz
Range(Range("B2"), Cells(UBound(valami, 1) + 1, y - 1)).Value = valami
Range(Cells(u, y), Cells(u + varia - 1, y)).Formula = kepl
Range(Cells(u, y), Cells(u + varia - 1, y)).Value = Range(Cells(u, y), Cells(u + varia - 1, y)).Value
Application.ScreenUpdating = True
Range("A1").Select
MsgBox "Készen vagyok!"
End Sub
Sub sokszoroz(ByRef mit, hova, hanyszor, ciklus, ByRef valami())
Dim x As Long, cl As Range, w As Integer, z As Long
x = 1
For z = 1 To ciklus
   For Each cl In mit.Cells
      For w = 1 To hanyszor
         valami(x, hova) = cl.Value
         x = x + 1
      Next
   Next
   DoEvents
Next
End Sub

  Ha bármi probléma adódik, csak írj.
  Üdv.

• #42133 Mutt aktív tag dav<3 #42028

  Új Válasz 2019-11-07 20:47:01 #42133

  Ú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

  

  Mutt

  aktív tag

  válasz dav<3 #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

  [ Szerkesztve ]

  A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel

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