Hirdetés

Keresés

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

  • Fferi50

    Topikgazda

    válasz hunniaa #53907 üzenetére

    Szia!
    Háát, gondolatolvasó nem vagyok. Mindenesetre próbáld kicserélni erre az osszetevok eljárást:
    Sub osszetevok()
    Dim rngossze As Range, rngalap As Range, sh1 As Worksheet, sh2 As Worksheet, toszlop As Integer, cl As Range, i As Integer
    Set sh1 = Sheets("Gyártmánylap"): Set sh2 = Sheets("Alapanyag")
    Set rngossze = sh2.Range("A2").CurrentRegion
    Set rngalap = sh1.Range("B3")
    toszlop = sh2.Rows(1).Find(what:=rngalap.Value, LookIn:=xlValues, lookat:=xlWhole).Column
    rngossze.AutoFilter field:=toszlop, Criteria1:=">0"
    sh1.Range("B10:B21").ClearContents
    i = 10
    For Each cl In rngossze.Columns(toszlop).SpecialCells(xlCellTypeVisible).Cells
        If cl.Row > 3 Then
           If cl.Value <> "" Then sh1.Cells(i, 2).Value = sh2.Cells(cl.Row, 2).Value: i = i + 1
        End If
    Next
    rngossze.AutoFilter
    End Sub
    Hibakezelés nincs benne még, ha pld. nincs meg a kiválasztott fagyi az alapanyag táblában (bár talán ilyen nem igen lesz).
    Ha bármi gond adódna, írj légy szíves akár priviben.
    Üdv.

  • Fferi50

    Topikgazda

    válasz hunniaa #53902 üzenetére

    Szia!
    Írtam is, hogy O365 esetén működik a képlet.
    Ha lehet makrózni, akkor a következő 2 makrót másold be a Gyártmánylap kódlapjára (lapfülön jobb egérgomb - kód megjelenítése):
    Sub osszetevok()
    Dim rngossze As Range, rngalap As Range, sh1 As Worksheet, sh2 As Worksheet, tszoveg As String, ttomb
    Set sh1 = Sheets("Gyártmánylap"): Set sh2 = Sheets("Összetevők")
    Set rngossze = sh2.Range("A2").CurrentRegion
    Set rngalap = sh1.Range("B3")
    tszoveg = Application.VLookup(rngalap, rngossze, 2, 0)
    tszoveg = Mid(tszoveg, InStr(tszoveg, ":") + 2)
    If InStr(tszoveg, "Tartalmaz") > 0 Then tszoveg = Left(tszoveg, InStr(tszoveg, "Tartalmaz") - 2)
    ttomb = Split(Replace(tszoveg, ", ", ","), ",")
    Range("B10:B21").ClearContents
    Range("B10:B" & 10 + UBound(ttomb)).Value = Application.Transpose(ttomb)
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    osszetevok
    Application.EnableEvents = True
    End Sub
    Ezután a beállításokban engedélyezned kell a makrókat és makróbarátként kell elmentened.
    A makró minden olyan alkalommal, amikor a B3 cellában változtatod az értéket, kiírja az összetevőket (ha vannak... ).
    Ha nem lehet makróznod, akkor képletekkel is meg lehet oldani, csak ennél egy "kicsit" bonyolultabb, írd meg légy szíves, ha szükséges.
    Üdv.

  • Fferi50

    Topikgazda

    válasz hunniaa #53864 üzenetére

    Szia!
    Ha 0365 van nálad, akkor a B10 cella képlete:
    =SZÖVEGFELOSZTÁS(SZÖVEGELŐTTE(SZÖVEGUTÁNA(FKERES(Gyártmánylap!B3;Összetevők!$A$2:$C$51;2;0);"Összetevők: ";;1);"*");;", ")
    Mielőtt a képletet beírod, töröld ki a B10 cellától lefelé a B20-ig azt ami most ott van - az érvényesítést beleértve! - továbbá szüntesd meg a cellák egyesítését!
    Ezután ha változtatod a B3 cella értékét, automatikusan megjelenik az összetevők listája és a képletek értéke az adott cellákban.
    Arra figyelj, hogy az elnevezések ugyanolyanok legyenek mindenütt, hogy megtalálja a képlet azokat.
    Üdv.

  • Fferi50

    Topikgazda

    válasz hunniaa #53819 üzenetére

    Szia!
    Nézd meg a következő képletet a C18 cellára:
    =SZORZATÖSSZEG(INDEX(Alapanyag!$C$3:$F$9;0;HOL.VAN(Tápanyagérték!$B18;Alapanyag!$C$1:$F$1;0));INDEX($C$3:$J$9;0;HOL.VAN(C$17;$C$2:$J$2;0)))*INDEX(Alapanyag!$C$2:$F$2;0;HOL.VAN(Tápanyagérték!$B18;Alapanyag!$C$1:$F$1;0))
    Ha így adod meg, másolható lefelé és oldalra is.
    Üdv.

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

Hirdetés