- Megérkezett a Google Pixel 7 és 7 Pro
- Xiaomi 13 - felnőni nehéz
- iPhone topik
- BlitzWolf termékek topicja
- Milyen okostelefont vegyek?
- Samsung Galaxy S22 és S22+ - a kis vagány meg a bátyja
- Android alkalmazások - szoftver kibeszélő topik
- Samsung Galaxy Watch8 - Classic - Ultra 2025
- Honor Magic V5 - méret a kamera mögött
- Sony Xperia 1 VII - Látod-e, esteledik
Hirdetés
-
Mobilarena
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
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
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Eladó Steam kulcsok kedvező áron!
- Surface Laptop 7 Business edition - Intel Core ultra 5 236V energiahatékonyabb az intelnél! -olvass
- Eladó egy wittings steel hr sport hibrid okos óra dobozával töltővel
- Telefon felvásárlás!! iPhone 13 Mini/iPhone 13/iPhone 13 Pro/iPhone 13 Pro Max/
- Bomba ár! HP ProBook 430 G7 - i5-10GEN I 16GB I 256SSD I HDMI I 13,3" FHD I Cam I W11 I Gar
- Csere-Beszámítás! Playstation 5 Lemezes kiadás!
Állásajánlatok
Cég: FOTC
Város: Budapest