-
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
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 IntegerSet sh1 = Sheets("Gyártmánylap"): Set sh2 = Sheets("Alapanyag")Set rngossze = sh2.Range("A2").CurrentRegionSet rngalap = sh1.Range("B3")toszlop = sh2.Rows(1).Find(what:=rngalap.Value, LookIn:=xlValues, lookat:=xlWhole).Columnrngossze.AutoFilter field:=toszlop, Criteria1:=">0"sh1.Range("B10:B21").ClearContentsi = 10For Each cl In rngossze.Columns(toszlop).SpecialCells(xlCellTypeVisible).CellsIf cl.Row > 3 ThenIf cl.Value <> "" Then sh1.Cells(i, 2).Value = sh2.Cells(cl.Row, 2).Value: i = i + 1End IfNextrngossze.AutoFilterEnd 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, ttombSet sh1 = Sheets("Gyártmánylap"): Set sh2 = Sheets("Összetevők")Set rngossze = sh2.Range("A2").CurrentRegionSet 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").ClearContentsRange("B10:B" & 10 + UBound(ttomb)).Value = Application.Transpose(ttomb)End SubPrivate Sub Worksheet_Change(ByVal Target As Range)If Intersect(Target, Range("B3")) Is Nothing Then Exit SubApplication.EnableEvents = FalseosszetevokApplication.EnableEvents = TrueEnd 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
- Melyik tápegységet vegyem?
- Itt a Galaxy S26 széria: az Ultra fejlődött, a másik kettő alig
- OLED TV topic
- iPhone topik
- Kés topik
- Xiaomi 15 - kicsi telefon nagy energiával
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- 18. helyet ért a Samsung Galaxy S26 Ultra kamerarendszere a DxOMarknál
- Formula-1
- VR topik
- További aktív témák...
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Samsung Galaxy S24 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Eredeti Microsoft Windows 10 / 11 Pro OEM licenc Akciós áron! 64/32 bit Azonnali kézbesítéssel
- iPhone 11 64GB 100% (3hónap Garancia)- AKCIÓ
- LG 27GS95QE - 27" OLED / QHD 2K / 240Hz & 0.03ms / 1000 Nits / NVIDIA G-Sync / AMD FreeSync
- ÁRGARANCIA!Épített KomPhone Ryzen 5 7500F 32/64GB DDR5 RTX 5060 8GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50