- Samsung Galaxy A56 - megbízható középszerűség
- Magyarított Android alkalmazások
- Telekom mobilszolgáltatások
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- Samsung Galaxy S25 - végre van kicsi!
- Samsung Galaxy S21 FE 5G - utóirat
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Samsung Galaxy A55 - új év, régi stratégia
- Samsung Galaxy A54 - türelemjáték
-
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
-
Mutt
senior tag
válasz
andreas49
#54482
üzenetére
Szia.
A képletból hiányzik a megfelelő helyről zárójel.
Az első JOBB után 2 db záró-zárójel kell, az egyik zárja a jobb oldali csonkolást, a második pedig létrehozza a dátumot az adott év, hónap és nap alapján.
A helyes számításhoz a legelső Dátum elé kell még egy nyitó-zárójel, mert előbb a különbséget akarjuk kiszámolni, majd azt 365-el elosztani.Sortörésekkel ez a helyes formátum. Excelben sortörések nélkül kell majd neked.
=KEREKÍTÉS((DÁTUM(BAL(H2;4);KÖZÉP(H2;5;2);JOBB(H2;2))-DÁTUM(BAL(XKERES(K2;ALAP!AB:AB;ALAP!AF:AF);4);KÖZÉP(XKERES(K2;ALAP!AB:AB;ALAP!AF:AF);5;2);JOBB(XKERES(K2;ALAP!AB:AB;ALAP!AF:AF);2)))/365;0)Három kérdés/észrevétel:
1. Excel 2021-től lehet használni a LET függvényt, amivel az ismétlődő részeket lehet egyszerűsíteni illetve felgyorsítani. pl. 3x keresed ki ugyanazt az értéket, ezt lehet rövidíteni, vagy akár a dátumra alakítást.=LET(adat1;H2;adat2;XKERES(K2;ALAP!AB:AB;ALAP!AF:AF);atalakit;LAMBDA(x;DÁTUM(BAL(x;4);KÖZÉP(x;5;2);JOBB(x;2)));eredmeny;KEREKÍTÉS((atalakit(adat1)-atalakit(adat2))/365;0);eredmeny)
2. Van vmilyen indoka, hogy a dátumok nem értékként hanem szövegként vannak tárolva? Ha csak megjelenítésről van szó, akkor cella számformátummal meg lehet oldani. Ezzel a szöveges változattal csak hátrány van, nem tudsz pl. kimutatásban csoportosítani.
3. Kipróbálhatod, hátha a DÁTUMÉRTÉK függvény a H és az AF oszlopon is megfelelő.üdv
-
Fferi50
Topikgazda
válasz
andreas49
#54336
üzenetére
Privátban megoldódott!
Ha valaki kíváncsi lenne rá:
Nem megjegyzés/jegyzet volt a cellában, hanem hivatkozás (hyperlink).
Az egérmutató rávitele pedig a HIVATKOZÁS munkalapfüggvény megjelenő szöveg paraméterbe kerülő szöveget mutatja meg.
Ezt VBA-val a Range.Hyperlink ScreenTip paraméterével lehet kinyerni. Mivel egy cellához több hyperlink is csatolható, ezért az egyikek (akár az egyetlent is!) a Hyperlinks(index) formában lehet kinyerni. Vagyis a B2 cellához kapcsolódó érték kinyerése:Range("B2").Hyperlinks(1).ScreenTip
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#54336
üzenetére
Szia!
Az egérmutató rávitele a cellára sajnos nem kezelhető eseményként, így nem lehet hozzá eseménykezelőt sem írni.
Két egéresemény van, a BeforeDoubleClick és a BeforeRightClick. Kényelmi szempontból a jobb egérkattintást látom használhatónak, erre írtam is egy makrót, amit a munkalap kódlapjára kell beírni:Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Dim cmts As CommentsThreaded, cmt As CommentThreaded, cmtas As Comments, cmta As Comment, cmtjel As BooleanIf Me.CommentsThreaded.Count > 0 ThenSet cmts = Munka1.CommentsThreadedFor Each cmt In cmtsIf Target.Address = cmt.Parent.Address ThenApplication.EnableEvents = FalseTarget.Offset(0, 1).Value = cmt.Textcmtjel = TrueExit ForEnd IfNextEnd IfIf Not cmtjel ThenIf Me.Comments.Count = 0 ThenCancel = FalseExit SubElseSet cmtas = Me.CommentsFor Each cmta In cmtasIf Target.Address = cmta.Parent.Address ThenApplication.EnableEvents = FalseTarget.Offset(0, 1).Value = cmta.Textcmtjel = TrueExit ForEnd IfNextEnd IfEnd IfApplication.EnableEvents = TrueEnd Sub
A makró jobb egérkattintásra indul, mind a megjegyzést, mind a jegyzetet figyeli és amennyiben a cellához kapcsolódik, akkor a mellette levő cellába kiírja az értékét.
Ezután láthatóvá válik a jobb egérkattintás menüje. (Erre azért van szüksége, mert másként nem tudnád törölni a cella megjegyzését/jegyzetét.)
Ha nincs sem megjegyzés, sem jegyzet, akkor csak a menü jelenik meg.
Amire figyelned kell: Az adott cellára akárhányszor megcsinálhatod a jobb egérkattintást, mindannyiszor újra felülírja a megjegyzés/jegyzet értékét. Ha közben változtattál a szövegen, akkor egy plusz jobb egérkatt kell ahhoz, hogy a mellett levő cellában megjelenjen az új szöveg.
Ha bármilyen más értékek lennének az adott cella mellett, azok is felülíródnak a megjegyzés/jegyzet szövegével!!!
Mindig csak azt a cellát vizsgálja, amin kattintottál - egyértemű működés érdekében csak egy db cellát jelölj ki a kattintásra!
A munkafüzetet makróbarátként kell elmentened!
Üdv. -
föccer
nagyúr
válasz
andreas49
#53944
üzenetére
Inkább az, hogy egy szélesség minusz értéket kellett volna, hogy felvegyen, ami minium 0 lehet.
#53939andreas49
az is működik, hogy csinálsz 1 db "kezelő" fület, amire kirakod a gombbot, meg ottani cellákba teszed bele az alapadatokat. De az is pörfikt, hogy imputbox szedi be az eltolást. Ekkor én public-ba raknám a makrót és ráblindelnék egy hotkey-t és akkor bármikor, 1 gombnyomásra megcsinálja.üdv, föccer
-
Delila_1
veterán
válasz
andreas49
#53939
üzenetére
Sub Szelesseg_igazitas_1()Dim i As Integer, plusz As Integerplusz = Application.InputBox("Hány ponttal legyen szélesebb az oszlop?", Type:=1)ActiveSheet.UsedRange.Columns.AutoFitFor i = 1 To ActiveSheet.UsedRange.Columns.CountColumns(i).ColumnWidth = ActiveSheet.Columns(i).ColumnWidth + pluszNextMsgBox "Kész"End Sub -
jerry311
nagyúr
válasz
andreas49
#53939
üzenetére
Megteheted azt is, hogy nincs cellahoz rendelve a makro.
Tehat a
...Sheets("Munka2").Range("A1").Value...helyere beirod a fix erteket, amivel novelni szeretned az oszlopok szelesseget. Ebben annyi a kenyelmeten, hogy a makron kell valtoztatni minden alkalommal, amikor masik ertekkel akarod novelni az oszlopok szelessebget. Viszont nincs se masodik munkalap, se gomb, se beviteli mezo egyik munkalapon se. -
Mutt
senior tag
-
Mutt
senior tag
válasz
andreas49
#53631
üzenetére
Szia,
Az aktuális munkalapon próbálja meg átalakítani a dátumokat a kijelölt cellákban.
Sub DatumAlakit()Dim adatok As Range, adat As RangeDim lapnev As StringDim honap As String, nap As String, eredmeny As StringDim magyarHonap, angolHonapDim c As Long, karakter As String * 1angolHonap = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")magyarHonap = Array("jan#", "feb#", "már#", "ápr#", "máj#", "jún#", "jûl#", "aug#", "szept#", "okt#", "nov#", "dec#")lapnev = Trim(ActiveSheet.Name)Set adatok = Intersect(ActiveSheet.UsedRange, Selection)For Each adat In adatoknap = ""honap = ""eredmeny = adat'csak akkor fusson le ha még nincs évszámIf InStr(1, adat, lapnev) = 0 Then'karakternként végigmegyünk a cella tartalmánFor c = 1 To Len(adat)'ha szám van akkor a nap tömbbe tesszük, ha betû a hónap tömbbekarakter = Mid(adat, c, 1)Select Case UCase(karakter)Case "0" To "9", "-"nap = nap & karakterCase "A" To "Z"honap = honap & karakterEnd SelectNext cEnd If'angol hónap nevek magyarra cseréléseFor c = 0 To UBound(angolHonap)honap = Replace(honap, angolHonap(c), magyarHonap(c), Compare:=vbTextCompare)Next c'végeredmény összerakásaDim honapok, napokIf Len(honap) > 0 And Len(nap) > 0 Thenhonapok = Split(Left(honap, Len(honap) - 1), "#")'ha van hónap akkor használjukIf IsArray(honapok) ThenIf UBound(honapok) > 0 Then'ha több hónap van, akkor több nap is kellnapok = Split(nap, "-")eredmeny = lapnev & ". " & Replace(honapok(0), "#", "") & ". " & napok(0) & " - " _& Replace(honapok(1), "#", "") & ". " & napok(1)Elseeredmeny = lapnev & ". " & Replace(honapok(0), "#", "") & ". " & napEnd IfEnd IfEnd If'adat.Offset(, 1) = eredmeny 'teszteléshez ezt a sort aktiváld, a következõd kommenteld beadat = eredmenyNext adatEnd SubNem tudom, hogy mennyire megy a te adatsorodon. Érdemes előbb egy teszt fájlban kipróbálni.
üdv
-
Fferi50
Topikgazda
válasz
andreas49
#53631
üzenetére
Szia!
Ha jól gondolom, ezek a "dátum formák" szöveges értékek az adott cellában, mivel az Excel/VBA a dátumot/időt konkrét számértékként kezeli. A mutatott értékek pedig intervallumot jelentenek.
Honnan jön az év? Az aktuális munkalap neve tartalmazza? Vagy valahonnan máshonnan lehet kinyerni?
Egyébként akár a Keres - Cserél Excel funkció is használható lehet.
Üdv. -
ny.janos
tag
válasz
andreas49
#53601
üzenetére
Szia!
Az MNB oldaláról történő árfolyamkereséseket én meguntam egyszer, ezért PQ-t akalmazok a lekérdezéshez.
Az excel-bazison van egy ingyenes anyag erről.Én az alábbi kódot alkalmazom (értelemszerűen ha más időszaki árfolyamokra vagy kíváncsi, vagy más devizanemek is kellenek, akkor módosítható).
let
Forrás = Web.Page(Web.Contents("https://www.mnb.hu/arfolyam-tablazat?deviza=rbCustom&devizaSelected=HUF&datefrom=2020.01.01.&datetill=2029.12.31.&order=1&customdeviza%5B%5D=CHF&customdeviza%5B%5D=EUR&customdeviza%5B%5D=USD&customdeviza%5B%5D=GBP&customdeviza%5B%5D=RUB")),
Data0 = Forrás{0}[Data],
#"Oszlopok átnevezve" = Table.RenameColumns(Data0,{{"CHF svájci frank 1", "CHF"}, {"EUR euro 1", "EUR"}, {"GBP angol font 1", "GBP"}, {"RUB orosz rubel 1", "RUB"}, {"USD USA dollár 1", "USD"}}),
#"Típus módosítva" = Table.TransformColumnTypes(#"Oszlopok átnevezve",{{"", type date}, {"CHF", type number}, {"EUR", type number}, {"GBP", type number}, {"RUB", type number}, {"USD", type number}}),
#"Oszlopok átnevezve1" = Table.RenameColumns(#"Típus módosítva",{{"", "Dátum"}})
in
#"Oszlopok átnevezve1"Üdv.
-
Fferi50
Topikgazda
válasz
andreas49
#53601
üzenetére
Szia!
Nem tudom, hogy miért fontos neked a feldolgozásnál az ÉÉÉÉ.HH.NN formátum, mivel a dátumot a rendszer számként tartja nyilván - csak a megjelenítés változik a formázási szabályok szerint.
Mivel a bemásolásnál a dátumot tartalmazó oszlop szöveg, ezért dátummá kell alakítani, ami operációs rendszer függő is.
Nálam ez a képlet vált be a D4 cellában, ami lefelé húzható:=DÁTUMÉRTÉK(HELYETTE(BAL(A4;SZÖVEG.KERES(",";A4)-2);"november ";"11."))
Nyilván más hónapot a neki megfelelő számmal kell helyettesíteni és figyelembe kell venni, hogy a rendszerdátumban vannak-e szóközök, vesszők, annak megfelelően kell a helyettesítéseket megcsinálni.
Az első két cella általános formátumú, a többi formátumot megváltoztattam ÉÉÉÉ.HH.NN formátumra - DE ne feledd, azokban a cellákban is szám van a formátum mögött!
Üdv.
Ps. Nem egészen értem, hogy az A4 cellában levő szöveget miért nem eszi meg egy az egyben a DÁTUMÉRTÉK függvény, annak ellenére, hogy az is egy rendszer dátum formátum.... akkor egyáltalán nem kellene variálni. -
Mutt
senior tag
válasz
andreas49
#53462
üzenetére
Szia,
Itt az én megoldásom MS365-ös függvényekkel, segédoszlop nélkül. Feltételeztem hogy csökkenő sorrend érdekel, ha nem akkor a -1-eket a rendezésben 1-re kell cserélni.
C2-nek a képlete (tördelés csak a könnyebb olvashatóság miatt):=LET(adat;INDIREKT("A2:B7");lista;RENDEZÉS.ALAP.SZERINT(adat;INDEX(adat;0;1);-1;INDEX(adat;0;2);-1);XHOL.VAN(A2&"-"&B2;INDEX(lista;0;1)&"-"&INDEX(lista;0;2)))Egy másik változat pedig SZŰRŐ-t használva (ez van a D-oszlopban):
=LET(adat;INDIREKT("A2:B7");lista;VÍZSZ.HALMOZÁS(RENDEZÉS.ALAP.SZERINT(adat;INDEX(adat;0;1);-1;INDEX(adat;0;2);-1);SORSZÁMLISTA(SOROK(adat)));a;INDEX(lista;0;1);b;INDEX(lista;0;2);c;INDEX(lista;0;3);SZŰRŐ(c;(a=A2)*(b=B2)))Mindkét esetben a LET utáni első változó deklaráció azért van, hogy csak ott kelljen változtatnod a tartományt.
üdv
-
-
Fferi50
Topikgazda
válasz
andreas49
#53462
üzenetére
Szia!
2 db egyformára működik ez a képlet, de csak akkor, ha egymás után vannak az egyformák:=RANG.EGY(A1;$A$1:$A$4;0)+HA(DARABHA($A$1:$A$4;A1)>1;HA(RANG.EGY(B1;$B$1:$B$4)>RANG.EGY(A1;$A$1:$A$4;0);1;0))
Ha több egyforma van, arra még nincs megoldásom.
Képlet nélküli megoldás:
Rendezés: első szint A oszlop, második szint B oszlop. C oszlopba pedig 1 től induló sorszám. Ez biztosan működik akárhány A oszlopban levő egyezés mellett, ha nincs ugyanott B oszlopi egyezés.
Üdv. -
#53456
Peterhappy
őstag
andreas49
#53455
Peterhappy
őstag
válasz
andreas49
#53455
üzenetére
Köszönöm szépen a gyors választ.
Nem egészen, a lényeg az lenne, hogy előjelet nekem ne kelljen beírnom.De adtál egy ötletet!
Képlettel át tudom másolni az értékeket másik fülre, ahol feltételek használatával negatív számmá tudom varázsolni a kiadásokat - ha azokat emelem be a pivotba, rendben leszek. Legalábbis remélem.Szóval köszönöm a segítséged
Ha nem sikerülne, visszatérek. -
Delila_1
veterán
válasz
andreas49
#52400
üzenetére
Az eredeti füzetedben. Az első Evszam az A1 (vagy címsor esetén A2).
Kijelölöd a Match függvénnyel másolandó sorokat, Ctrl+C, átlépsz a megnyitott másik füzetbe, ott is az Evszam lapra, A1-be, és beilleszted.
Nyomás vissza az eredeti füzetbe, kikeresed a következő évszám sorát (match;1)+1, az értéket beteszed az Evszam változóba. Innen ez lesz a másolandó tartomány kezdő sora, az utolsót kikeresed az új évszámot megadva match,1-gyel. -
-
Delila_1
veterán
válasz
andreas49
#52394
üzenetére
Megnyitod az első nagy fájlt. Felveszel egy változót a füzet nevével.
Rendezed a tartományt az évszám szerint. Evszam változót veszel fel. Az első évszám az oszlopban.
Kijelölöd a másolandó tartományt –első sor=Match(Evszam, columns(1),0) , utolsó sor= Match(Evszam, columns(1),1).
Innen lesz az ismétlés
Megnyitod a füzetet, ahova másolni akarod külön lapokra az évszám szerinti adatokat. Ellenőrzöd, hogy van-e már Evszam nevű lap.
Dim WS As Workbook, Evszam As String
Evszam = "2024" ’az oszlopban lévő első évszám
On Error Resume Next
Set WS = Sheets(Evszam)
If Err.Number = 9 Then
Sheets.Add.Name = Evszam
Else
Sheets(Evszam).Select
End If
On Error GoTo 0
Kikeresed az első üres sort, beilleszted a tartományt.
Eddig
Vissza az első nagy fájlba, megadod a következő évszámot – ennek asora=range(„A” & Match(Evszam, columns(1),1)+1. Ezt az értéket adod meg új évszámként.Vajh' mennyire követhető ez?
-
Fferi50
Topikgazda
válasz
andreas49
#52244
üzenetére
Szia!
Akkor nem kell a Val függvény szerintem.
Van / vagy csinálsz - a munkalapon egy listát a számokból egy tartományban. Ezt rendezed növekvő vagy csökkenő sorrendbe, ahogy szeretnéd.
A makróban pedig végigmész a tartományon pl. így (a lista a lista nevű munkalap A oszlopában van):for xx=1 to Sheets.Count-1 Sheets("lista").Cells(xx,1).Text.Move before:=Sheets(xx):Next
Ez működik növekvő és csökkenő sorrend szerint is, ahogyan a listát rendezed a makró indítása előtt -- ill. a rendezést is beleteheted a makróba.
Fontos, hogy a listát tartalmazó munkalap névvel legyen a tartomány előtt, mert ha közben elmozdul, a sima cella az aktuális munkalapra fog mutatni, amiben ki tudja milyen érték van az adott helyen.
Ha külön munkalapon van a munkalap számlistád azt el is rejtheted.
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#52236
üzenetére
Szia!
A munkalapok nevei szövegek (akármi is a létrehozás forrásformátuma)! Ezért a rendezés során számmá kell alakítanod:
Ha csak számokból áll a lap neve, akkor pl. Val(sheets(1).Name) < Val(Sheets(2).Name)
(vagy sorbamész a számlistádon és a listának megfelelő helyre teszed munkalapot.)
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#52105
üzenetére
Szia!
Ezt az egyoldalas definíciót továbbra sem értem. Amit ellenőrzésnek írtál, megnézegettem. Úgy látom, hogy a számok karakterszélessége a legtöbb betűtípusnál azonos - gondolom pont azért, hogy lehessen egymáshoz igazítani.
Viszont a betűk szélessége már lényegesen eltér lényegében minden betűtípusnál. Az i egy pont széles, az a legalább kettő, m pedig 3. Ezek mind régi meghatározással TrueType betűtípusok, nyomtatásban és képernyőn egyformán jelennek meg.
Volt - és talán ma is van - olyan betűtípus, amelyben a betű és számok azonos széles helyet foglaltak el - i és a egymás alatt ugyanolyan széles volt, 3 i alatt elfért a 3 a betű. Ez nyomtatáskor nem így volt, emiatt jöttek aztán a TrueType betűtípusok.
A régi mint pl. a Terminal betűtípusokat már csak nagyítóval lehet megtalálni szerintem.
Nyilván nem minden betűtípusnál figyeltek arra, hogy a számok egyforma szélesek legyenek. Sajnos ennek a jelölése viszont nincs meghatározva, úgy tudom.
Tehát marad ezután is a Próba-Cseresznye...Üdv.
-
Fferi50
Topikgazda
-
Fferi50
Topikgazda
válasz
andreas49
#52100
üzenetére
Szia!
Mit jelent az, hogy egyoldalas betűkészlet?
"Miért helytelen helyesírás szempontjából a "betűkészletként" szó?"
Ha az aláhúzásra gondolsz, azért van, mert a hosszú ékezetes betűket tartalmazó szavakat nem szereti az itteni helyesírás ellenőrző (és a google mail sem írás közben). -
karlkani
aktív tag
válasz
andreas49
#51736
üzenetére
Van pár rejtett, azokat nem ajánlja fel.
Át kellene olvasni, mi mire való. A példákban magyar megfelelők vannak írva (é, n, én), ezeket el kell felejteni (van y, m, d, md, ym, yd). N nincs, m van, az időszak teljes hónapjainak száma, ami 14. Ha d-t írsz, akkor 440-et ad eredményül.
-
föccer
nagyúr
válasz
andreas49
#51730
üzenetére
Az agromentumok listájában nem látom az "N"-et, csak az "M"-et. Nem elírás?
Illetve ha valamiért nincs, akkor simán vond ki a két dátumot egymásból, ekkor egy dátum értéket kapsz, ami gyakorlatilag napokban adja meg a különbséget. Ha precízebben kell csak a hónap, akkor nyerd ki a dátumból az évet és a hónapot. és ebből számítsd ki az eltelt hónapokat. (év(dátum2-év(dátum1))*12+hónap(dátum2)hónap(dátum1)
ha leakadtsz, akkor hétfőn összerakom O365-ben, sima liba.
üdv, föccer
-
Mutt
senior tag
válasz
andreas49
#51654
üzenetére
Szia,
Az én változatomban a feladás figyelembevételéhez elég csak a P3-ban lévő képletet módosítani.
Kacifántos lett, remélem okés nálad is.=LET(game1;MAX(ELŐJEL(nyertszett(G3:I3))-DARABHA(G3:I3;"R");0);
game2;MAX(ELŐJEL(nyertszett(J3:L3))-DARABHA(J3:L3;"R");0);
game3;MAX(ELŐJEL(nyertszett(M3:O3))-DARABHA(M3:O3;"R");0);
total;KEREK.FEL(DARAB2(G3:O3)/3;0);
felad;DARABHA(G3:O3;"R");
win;game1+game2+game3;
win&"-"&MIN(total-win+felad;total))üdv
-
Mutt
senior tag
válasz
andreas49
#51657
üzenetére
Szia,
5 bejegyzéssel feljebb a double unary operátorról ("--", két negatívjel egymás után) volt szó, ami a leggyorsabb megoldás egy szövegként ábrázolt szám értékké alakítására. Más megoldások is vannak, ha értékké kell alakítani egy szövegként tárolt számot:
- eggyel szorozni,
- nullát hozzáadni,
- ÉRTÉK/VALUE függvényt használni.A névkezelőben a pontadott és pontkapott függvényekben én is használtam a double unary-t, de a fájlodban vmiért nem megy (ha kézzel újból beírom a kettő mínuszjelet akkor nálam megy).
Próbáld meg ezen változatot:pontadott
=LAMBDA(x;HAHIBA(INDEX(SZÖVEGFELOSZTÁS(x;;"–");1)+0;""))pontkapott
=LAMBDA(x;HAHIBA(INDEX(SZÖVEGFELOSZTÁS(x;;"–");2)+0;""))üdv
-
Mutt
senior tag
válasz
andreas49
#51645
üzenetére
Szia,
Kaptál már megoldást, én is mutatok egyet amellyel a M365-ben található újabb függvényeket (LAMBDA, LET, BYCOL) szeretném megismertetni.
Röviden pár szó róluk:
1. LAMBDA: ezzel saját függvényt lehet létrehozni, amivel a számításokat lehet egyszerúsíteni.
2. LET: itt változókat lehet létrehozni amik segítenek a számításokban anélkül hogy segédoszlopot kellene használni
3. BYCOL és BYROW: függvényeket lehet futtatni tömbökön amelyek oszlopban/sorban vannak.
Lépések:
1. A névkezelőben létrehoztam három saját függvényt a LAMBDA függvény segítségével.
pontadott képlete =LAMBDA(x;HAHIBA(--INDEX(SZÖVEGFELOSZTÁS(x;;"–");1);""))
pontkapott képlete =LAMBDA(x;HAHIBA(--INDEX(SZÖVEGFELOSZTÁS(x;;"–");2);""))
nyertszett pedig =LAMBDA(x;SZUM(HA(HAHIBA(BYCOL(x;pontadott)-BYCOL(x;pontkapott);0)>0;1;0)))Az első kettő a 6-2-es inputból (a függvényben x) 6-ot és 2-et ad vissza. Használata a füzetben pl. =pontadott(K3)
A harmadikban a BYCOL(x;pontadott) résszel elérhetjük, hogy mondjuk az J3:L3 tartomány celláiból megkapjuk az eredményt. Ha kivontjuk az adott és kapott pontokat egymásból, akkor megkapjuk hogy az adott szettet kinyerte meg. Van ott még hibakezelés, hogy az üres cellák ne okozzanak gondot.
2. A fenti függvények segítségével az R3 képlete:
=SZUM(BYCOL(G3:O3;pontadott))&"-"&SZUM(BYCOL(G3:O3;pontkapott))A Q3 képlete:
=LET(win;nyertszett(G3:O3);
total;DARAB2(G3:O3);
win&"-"&total-win)Itt a "win" nevű változóban tároljuk a nyert szettek számát. A "total" az összes játszottat adja meg, az eredményt pedig az utolsó soradja meg.
A P3 képlete:
=LET(win;ELŐJEL(nyertszett(G3:I3))+ELŐJEL(nyertszett(J3:L3))+ELŐJEL(nyertszett(M3:O3));
total;KEREK.FEL(DARAB2(G3:O3)/3;0);
win&"-"&total-win)Itt annyi változás van, hogy a 3-as szettekből kiderítjük kinyerte meg a gémet.
üdv
-
#51650
Fire/SOUL/CD
félisten
andreas49
#51645
válasz
andreas49
#51645
üzenetére
L3 képlete (lefelé másolható)
=INT(BAL(M3;1)/(DARABHATÖBB(C3:K3;"<>Fire")/3-1)) & "–" & INT(JOBB(M3;1)/(DARABHATÖBB(C3:K3;"<>Fire")/3-1))M3 képlete (lefelé másolható)
=SZUM(--HA(C3:K3<>"";HA(--BAL(C3:K3;1)>--JOBB(C3:K3;1);1;0);0)) & "–" & SZUM(--HA(C3:K3<>"";HA(--BAL(C3:K3;1)<--JOBB(C3:K3;1);1;0);0))N3 képlete (lefelé másolható)
=SZUM(--HA(C3:K3<>"";--BAL(C3:K3;1);0)) & "–" & SZUM(--HA(C3:K3<>"";--JOBB(C3:K3;1);0))
-
#51435
Fire/SOUL/CD
félisten
andreas49
#51434
-
Fferi50
Topikgazda
válasz
andreas49
#50828
üzenetére
Kiegészítés: egy kis trükkel talán megoldható:
Kell hozzá két segédoszlop.
Szűretlen adatokon
1. segédoszlop képlete =sor() ez végighúzva a teljes oszlopon.
Ezután szűrés bekapcsolás
2. segédoszlop képlete =sor() ez is végighúzva a látható tartományon
Szűrés kikapcsolva. A szűrésbe nem tartozó adatok sorában nem lesz érték.
A két segédoszlop kijelölése ameddig adatok vannak rajta - másolás - irányított beillesztés értékek ugyanoda.
A teljes adatállomány rendezése a 2. segédoszlop alapján - növekvő sorrendben.
A másolt értékek beillesztése a kívánt oszlopba.
Ezután ismét az adatállomány rendezése, most az 1. segédoszlop alapján.
Remélem sikerül megoldani a problémád.
Üdv. -
Fferi50
Topikgazda
válasz
andreas49
#50828
üzenetére
Szia!
Kicsit még mindig homályos a kérdésed.
A szűrt lista sorait - vagy akár egy oszlopát - egy lépésben húzással ki tudod jelölni, másolás -> beillesztés után pedig csak a kijelölt terület látszó/szűrt adatai kerülnek az új helyre.
Ha a szűrt lista egy oszlopába szeretnél bemásolni valahonnan, na az nem fog menni egy lépésben. Ott sajnos a nem látható sorokat is figyelembe veszi az Excel. Ezt makróval lehet csak megoldani.
Üdv. -
Mutt
senior tag
válasz
andreas49
#50785
üzenetére
Szia,
Nézd meg ezt az UDF-et.
Használata: =Hasonlo(<cella amihez hasonlót keresünk>;<tartomány a hasonló szövegekkel>;<max eltérések száma>;<kis és nagybetű eltérjen>)Function Hasonlok(mit As Range, hol As Range, Optional max_elteres As Long = 2, Optional kisnagybetuazonos As Boolean = False) As Variant
Dim dictMit As Object
Dim dictHol As Object
Dim adat As Range
Dim c As Long, elteres As Long
Dim key As String, val As Long
Dim collEredmeny As New Collection
Dim arrEredmeny()
'late biding-gal létrehozunk két szótárt, ahol {betű:darabszám} párosokat tudunk képezni
Set dictMit = CreateObject("Scripting.Dictionary")
Set dictHol = CreateObject("Scripting.Dictionary")
'on error a collection miatt kell, mert kiakad ha egy már létező elemet akarunk újra felvenni
On Error Resume Next
'végigmegyünk a megadott tartomány elemein
For Each adat In hol
'átugorjuk ha véletlenül a tartomány rész az eredeti szöveg amihez hasonlókat keresünk
If adat.Address <> mit.Address Then
'az eredeti szöveget és hasonlóság miatt vizsgáltat felbonyjuk {betű:darabszám} párosokra
Call felbont(Trim(adat.Text), dictHol, kisnagybetuazonos)
Call felbont(Trim(mit.Text), dictMit, kisnagybetuazonos)
'megnézzük, hogy a két szövegben mely betük egyeznek és a darabszámukat csökkentjük a
'másik szövegben található darabszámmal
For c = 0 To dictMit.Count - 1
key = dictMit.Keys()(c)
If dictHol.exists(key) Then
val = dictHol(key)
If val >= dictMit(key) Then
dictHol(key) = val - dictMit(key)
dictMit(key) = 0
Else
dictMit(key) = dictMit(key) - val
dictHol(key) = 0
End If
End If
Next c
'eltéresek megszámolása
elteres = szamol(dictMit) + szamol(dictHol)
'ha a limit alatt vagyunk eltérésekben akkor elrakjuk a szöveget
If elteres <= max_elteres Then collEredmeny.Add adat.Text
End If
Next adat
On Error GoTo 0
'tömbként visszaadjuk a talált elemeket ha vannak, különben üres szöveget adunk
If collEredmeny.Count > 0 Then
ReDim arrEredmeny(1 To collEredmeny.Count)
For c = 1 To collEredmeny.Count
arrEredmeny(c) = collEredmeny.Item(c)
Next c
Hasonlok = arrEredmeny
Else
Hasonlok = ""
End If
End Function
Private Function felbont(s As String, o As Object, m As Boolean)
Dim c As String
Dim x As Long
'töröljük az eddigi tartalmat
o.RemoveAll
'ha szükséges akkor mindent nagybetűsre alakítunk
If m Then s = UCase(s)
'felszabdaljuk a szöveget {betu:darabszám} párosokra
While Len(s) > 0
c = Left(s, 1)
x = Len(s) - Len(Replace(s, c, ""))
o.Add c, x
s = Replace(s, c, "")
Wend
End Function
Private Function szamol(o As Object) As Long
Dim x As Long
'megszámoljuk hány esetben fordul elő NEM nullaszor egy betű
'ezek azok amelyek a másik szövegben nem voltak megtalálhatók
szamol = 0
For x = 0 To o.Count - 1
If o.Items()(x) > 0 Then szamol = szamol + 1
Next x
End Functionüdv
-
sztanozs
veterán
válasz
andreas49
#50635
üzenetére
Illetve:
Sub AR_BAL_1_mod()
Dim ws As Worksheet
For Each ws In Workbooks("c:\temp\Munkafüzet15.xls").Worksheets
If ws.Type = xlWorksheet Then
ws.Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
ws.Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
ws.Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
ws.Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
End If
Next
End Sub -
Delila_1
veterán
válasz
andreas49
#50637
üzenetére
Megírtam, hogy a sok BAL képlet helyére illessze be minden lapon az értékeket. Kisebb lesz a fájl mérete, és gyorsabbak a műveletek.
Sub AR_BAL_1_mod()
Dim ws As Integer
For ws = 1 To Worksheets.Count
Sheets(ws).Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
Sheets(ws).Range("AM4:AQ155").Copy
Sheets(ws).Range("AM4").PasteSpecial xlPasteValues
Sheets(ws).Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
Sheets(ws).Range("AS4:AW155").Copy
Sheets(ws).Range("AS4").PasteSpecial xlPasteValues
Sheets(ws).Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
Sheets(ws).Range("AY4:BC155").Copy
Sheets(ws).Range("AY4").PasteSpecial xlPasteValues
Sheets(ws).Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
Sheets(ws).Range("BE4:BI155").Copy
Sheets(ws).Range("BE4").PasteSpecial xlPasteValues
Next
Application.CutCopyMode = False
End Sub -
Delila_1
veterán
válasz
andreas49
#50635
üzenetére
Próbáld meg így:
Sub AR_BAL_1_mod()
Dim ws As Integer
For ws = 1 To Worksheets.Count
Sheets(ws).Range("AM4:AQ155").FormulaLocal = "=Bal(E4;1)"
Sheets(ws).Range("AS4:AW155").FormulaLocal = "=Bal(N4;1)"
Sheets(ws).Range("AY4:BC155").FormulaLocal = "=Bal(W4;1)"
Sheets(ws).Range("BE4:BI155").FormulaLocal = "=Bal(AF4;1)"
Next
End Sub -
sztanozs
veterán
válasz
andreas49
#50632
üzenetére
Sub minden_munkalapra()
Dim ws As Worksheet
' Ide johet kozvetlen hivatkozas is ActiveWorkbook helyett
' pl Workbooks("akarmi.xls")
For Each ws In ActiveWorkbook.Worksheets
If ws.Type = xlWorksheet Then
' ide jon a kodod, csak az ActiveSheet vagy mas sheet hivatkozast ws-re kell cserelni
' ...
End If
Next
End Sub -
-
Mutt
senior tag
válasz
andreas49
#50587
üzenetére
Szia,
Lehetséges-e megváltoztatni az igazításnál a behúzás egységének nagyságát?
Próbálj egyéni számformátumot használni. Az aláhúzás jel az utána megadott karakter szélességével tolja jobbra a cella tartalmát.
A _+_+# ##0;_+_+-# ##0;_+_+0;_+_+@ formátum két plusz jelnyi helyet hagy ki számok és szövegek előtt, vagy ha csak a szövegeket akarod igazatni akkor legyen a formátum _+_+@üdv
-
Delila_1
veterán
-
Delila_1
veterán
válasz
andreas49
#50045
üzenetére
Kijelölöd a tartományt az alsótól a felsőig. Ctrl+g-re bejön az Ugrás menü. Kiválasztod az Irányított-at, majd az Üres cellák-at. Beírsz valamit, pl. egy pontot, majd Ctrl+Enterrel egyszerre beviszed az összes kijelölt cellába.
Most már nem kell külön nyolcanként a villámkitöltés, egy lépésben elvégezhető.
Szűröd az oszlopot a bevitt pontra, kijelölöd a sorokat, és törlöd a pontot. -
#50004
istvankeresz
aktív tag
andreas49
#50003
istvankeresz
aktív tag
válasz
andreas49
#50003
üzenetére
Üdv!
A megegyező nevű emberek textboxból berögzítésének problémájánál akadtam el.
Az működik, hogy berögzítek egy embert, aminek a neve lesz a worksheet neve, ilyenkor ugye ha még egy ugyanolyan nevű embert rögzittek, akkor az sikertelen.
Ha úgy oldom meg, hogy tegyen mellé egy valamilyen karaktert (Pl.: 2), akkor az is működik(egyszer). Harmadik ugyanilyen nevű embernél már ez is hibázik. Ez már nagyon kis eséllyel fordul elő, de hibás rögzítésnél könnyen előfordulhat.
Erre van kiforrott megoldás, vagy olyasmire gondoltam , hogy egy 2-től növekvő számot tegyen az ilyen esetekben a nevek mögé, és úgy hozzon létre egy új worksheet-t.
Másik problémám pedig ennek a problémának a figyelése. Próbáltam elágazásokkal, Case Select-el, de mindig valami félre ment. A koncepcióm az, hogy a rögzítő gomb megyomásakor egy ciklus végigfut a worksheeteken, ha nem talál egyező worksheetet, akkor létrehozza azzal nével, ami a textboxban van. Ha talál egyezőt, akkor megkérdi, hogy biztos rögzíted? Ez lenne a két megegyező nevű ember esete. Itt ha Igen.t nyom, akkor létrehozza a fent említett módon. Pl. Kovács Béla2. Viszont a ciklusokból nem sikerül jó helyen kilépnem. Mert a feltételek nem úgy teljesűlnek, ahogy én terveztem.
Most ezt faragom, de ez sem működik jól:
Dim answer As IntegerDim wbSearch As Workbook, wsSearch As WorksheetFor Each wsSearch In ActiveWorkbook.SheetsSelect Case wsSearch.NameCase Is <> TextBox11.ValueCase Is = TextBox11.Valueanswer = MsgBox("Ilyen nevű munkatárs már rögzítve! Biztos, hogy folytatod a rögzítést?", vbQuestion + vbYesNo + vbDefaultButton2, "Munkatárs rögzítése")If answer = vbYes ThenSheets("Szemely_TEMPLATE").Copy After:=Sheets("Havi_TEMPLATE")ActiveSheet.Name = TextBox11.Value & 2Sheets(TextBox11.Value).Range("A2") = TextBox11.Value & " " & ComboBox7.ValueSheets(TextBox11.Value).Range("B2") = TextBox12.ValueSheets(TextBox11.Value).Range("C2") = TextBox13.ValueSheets(TextBox11.Value).Range("D2") = TextBox14.ValueMsgBox "Munkatárs sikeresen rögzitve! Kérlek zárd be és nyisd meg újra a programot!"TextBox11.Value = ""ComboBox7.Value = ""TextBox12.Value = ""TextBox13.Value = ""TextBox14.Value = ""End IfIf answer = vbNo ThenTextBox11.Value = ""ComboBox7.Value = ""TextBox12.Value = ""TextBox13.Value = ""TextBox14.Value = ""End IfEnd SelectNext wsSearchSzóval ezen az úton indultam el. Ötlet?
-
#49210
Fire/SOUL/CD
félisten
andreas49
#49188
válasz
andreas49
#49188
üzenetére
Ó bakker, végül is sima szűrővel is megoldható...
Szűrőben kijelölöd azt az 50 országot, a szűrt listát kijelölöd, irányított kijelölés, csak a látható cellákat, ctrl+c, másik munkalap, ctrl+v, 50 sor kijelöl, és azonos sormagasságra állít (az előző munkalap sormagasságára) -
#49208
Fire/SOUL/CD
félisten
andreas49
#49188
válasz
andreas49
#49188
üzenetére
Itt az a gond, hogy cellába nem lehet képet betölteni, csak ahhoz igazítani. Az, hogy látszólag a felirattokkal együtt mozognak a képek, azt úgy oldják meg, hogy a kép méretének megfelelően vannak beállítva a sormagasságok ill. oszlopszélességek és amikor beszúrják a képeket, akkor az ALT gomb nyomva tartása mellett mozgatják a képet és így igazítják az adott cellához, de nem kerül bele a cellába. Ha a billentyűzeten a kurzormozgatókkal ráállsz egy látszólag képet tartalmazó cellára, akkor az adott cella tartalma üres lesz, itt az alábbi képen láthatod miről írok (A3-ban szöveg, B3-ban a kép, B3 üres).
A másik gond (orvosolható), hogy a beszúrt képekre objektumnévvel lehet hivatkozni vagy magára a kép fájlnevére (ahogy a HDD-n/SSD-n tárolva van)
Az alábbi kép bal-felső sarkában jól látható, hogy a Garfield kép beszúrása után az Excel automatikusan a Kép 1 objektumnevet adta neki.
Egy makró csak akkor fogja tudni megoldani az általad felvázolt feladatot, ha valahogy a szöveges országnevekhez egyértelműen tudja társítani az ahhoz tartozó képet.
Mint fentebb írtam, 2 lehetőség van.
1. Szépen egyenként át kell írni minden egyes kép objektum nevét az ország nevére (előbbi képet alapul véve a Kép 1-t Garfield-re)
2. Szépen egyenként át kell nevezni a képek fájlnevét az ország nevére és újra beszúrni őket.
Magyarország szöveghez-> Magyarország.png
Albánia szöveghez-> Albánia.png200 országnál és azokhoz tartozó képeknél egyik sem 1-2 perces meló, de az 1. pontban javasolt módszer lényegesen egyszerűbb és gyorsabb.
UI: Ezt azért még időben döntsd el, mert egyik hozzászólásodban másik munkalapra kellene másolni, másik hozzászólásodban meg már munkafüzetet említesz...
"Megoldható-e képlettel vagy macro-val, hogy képet másoljunk egyik munkalapról a másikra?"
"Ebből kell leválogatnom ~50 nevet képpel együtt (mindig más), de ezt új munkafüzetbe."
-
Mutt
senior tag
válasz
andreas49
#49138
üzenetére
Esetleg ez. Sok cellát tartalmazó lapon nem lesz gyors.
Sub Tisztit()
Dim wsCurrent As Worksheet
Dim rngData As Range
Dim cella As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each wsCurrent In Worksheets
Set rngData = wsCurrent.UsedRange
For Each cella In rngData
If Not cella.HasFormula Then cella = Trim(cella)
Next cella
Next wsCurrent
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub -
-
Delila_1
veterán
válasz
andreas49
#49098
üzenetére
Sub AblakRogzites()Dim lap As IntegerApplication.ScreenUpdating = FalseFor lap = 1 To Worksheets.CountSheets(lap).SelectRange("B2").Select 'Itt írd át a rögzítés helyétActiveWindow.FreezePanes = TrueNextApplication.ScreenUpdating = TrueEnd SubEz a makró minden lapon rögzíti az ablaktáblát B2-ben. Az első sor és első oszlop nem mozdul el görgetéskor. A B2 helyét átírhatod az igényednek megfelelően.
-
lappy
őstag
válasz
andreas49
#49081
üzenetére
nincs olyan függvény csak makróval lehet
Sub HomeAllSheets()
Dim sh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each sh In ActiveWorkbook.Worksheets
sh.Select
Range("A1").Select
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Next sh
Sheets(1).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub -
Mutt
senior tag
válasz
andreas49
#49005
üzenetére
Szia,
Itt egy makrós változat, amely a KIJELÖLT oszlopon végzi el az átalakítást és mellé írja be a kapott értékeket. Mivel nem írtad hogy mi történjen ha a formátum nem követi az "abc (def) [ghi]" formátumot ezért ahogy nekem logikusnak tűnt írtam meg a kódot. A kommentek alapján próbáld meg módosítani.
Sub Szetszed()
Dim cella As Range
Dim adatsor As Range
Dim pos1 As Long, pos2 As Long, pos3 As Long
Dim text1 As String, text2 As String, text3 As String
'a kijelölt és adatokat tartalmazó tartományt használjuk csak
Set adatsor = Application.Intersect(Selection, ActiveSheet.UsedRange)
'végig megyünk a cellákon
For Each cella In adatsor
text1 = ""
text2 = ""
text3 = ""
'keressük a szövegben a zárójelet
pos1 = InStr(1, cella, "(")
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
If pos1 > 0 Then
'ha van zárójel akkor a csonkoljuk a szöveget a talált pozícióig
text1 = Trim(Left(cella, pos1 - 1))
'keressük a szögletes árójelet
pos2 = InStr(pos1, cella, "[")
If pos2 > 0 Then
'ha van szögletes, akkor kivesszük a szöveget a zárójel utáni pozíciótól kezdve
text2 = Replace(Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1)), ")", "")
text3 = Replace(Trim(Mid(cella, pos2 + 1, Len(cella) - pos2)), "]", "")
Else
'nincs szögletes zárójel, de sima volt
pos2 = InStr(pos1, cella, ")")
text2 = Trim(Mid(cella, pos1 + 1, pos2 - pos1 - 1))
text3 = Trim(Mid(cella, pos2 + 1, Len(cella) - pos2))
End If
Else
'nem volt zárójel tartsuk meg az eredeti szöveget
text1 = cella
End If
'eredeti cella melletti oszlopokba írjuk az eredményt
cella.Offset(, 1) = text1
cella.Offset(, 2) = text2
cella.Offset(, 3) = text3
Next cella
End Subüdv
-
Mutt
senior tag
válasz
andreas49
#49000
üzenetére
Szia,
Van hibaüzenet?
Ez egy UDF (saját függvény) vagyis be kell írni a munkafüzeten, ha neked olyan makró kell ami automatikusan kitölti helyetted a többi oszlopokat, akkor az már sub-routine.
Magyar Excel-ben SZÖVEGFELOSZTÁS a függvény neve, lehet hogy csak INSIDER-ben van még.üdv
-
Mutt
senior tag
válasz
andreas49
#48996
üzenetére
Szia,
Tedd be a fájlba a lenti UDF-et, majd használd így:
Function TextPart(InputText, Optional Separator As String = " ", Optional PartStart As Long, Optional PartEnd As Long)
'Separator ha nincs megadva akkor szóközként értelmezzük
Dim arraySplit
Dim vFelsoMeret As Long
Dim i As Long
Dim txtResult As String
'szétszedjük a szöveget az elválasztójel alapján
arraySplit = Split(InputText, Separator)
'megnézzük hogy hány részre szedhető
vFelsoMeret = UBound(arraySplit)
If PartEnd = 0 Then PartEnd = PartStart
'ha az utolsó utáni darabot kérik, akkor is az utolsót adjuk
If PartEnd >= vFelsoMeret + 1 Then PartEnd = vFelsoMeret + 1
'ha a legelső darab előtti kell, akkor is az elsőt adjuk vissza
If PartStart <= 0 Then PartStart = 0
'megadjuk a kért részt
If PartEnd > PartStart Then
txtResult = ""
For i = PartStart To PartEnd - 1
txtResult = txtResult & arraySplit(i - 1) & Separator
Next i
TextPart = txtResult & arraySplit(PartEnd - 1)
Else
TextPart = arraySplit(PartStart - 1)
End If
End Functionüdv
Ps. Microsoft365-ben van már szövegdaraboló függvény is.
-
Mutt
senior tag
válasz
andreas49
#48984
üzenetére
Szia,
Ezt próbáld meg. A kommentek alapján tudod módosítani.
Sub vissza()
Dim wsTOC As Worksheet
Dim ws As Worksheet
Dim i As Long, c As Long
Dim result As Range
Dim back As Range
'a munkalap neve, ahíol megtalálhatók a lapok nevei, ezt javítsd a megfelelőre
Const TOC = "Start"
Set wsTOC = Worksheets(TOC)
'végig futunk a munkalapokon
For i = 1 To Worksheets.Count
Set ws = Worksheets(i)
'csak más nevű munkalapok érdekelnek
If ws.Name <> TOC Then
'keressük meg helyét a munkalapnak az összesítőn
Set result = wsTOC.Range("A:A").Find(ws.Name)
'ha nincs meg akkor ugorjuk át
If Not result Is Nothing Then
Set back = ws.Range("A2")
'ha üres lenne a cella akkor írjuk bele ezt, ha nem kell akkor töröld ki
If back = "" Then back = "vissza"
'ha már lenne hivatkozás, akkor töröljük a korábbit
If back.Hyperlinks.Count > 0 Then back.Hyperlinks.Delete
'adjuk hozzá a linket
back.Hyperlinks.Add Anchor:=back, Address:="", SubAddress:="'" & TOC & "'!" & result.Address
End If
End If
Next i
'nem kötelező de szüntessük meg az objektumokat
Set back = Nothing
Set result = Nothing
Set ws = Nothing
Set wsTOC = Nothing
End Subüdv
Az első két cella általános formátumú, a többi formátumot megváltoztattam ÉÉÉÉ.HH.NN formátumra - DE ne feledd, azokban a cellákban is szám van a formátum mögött!
Ha nem sikerülne, visszatérek.
De a Dec.Bin stb. megmaradt.
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Új, bontatlan World of Warcraft gyűjtői kiadások
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Eladó Steam kulcsok kedvező áron!
- BESZÁMÍTÁS!Gigabyte B650M R7 7800X3D 64GB DDR5 1TB SSD RTX 3080Ti 12GB Corsair 4000D Airflow TG 750W
- Nintendo Switch bazár (Okosított Nintendo Switch konzolok, játékok, tartozékok)
- Bomba ár! Dell Latitude 7390 2in1 - i7-8G I 16GB I 256SSD I 13,3"FHD Touch I HDMI I Cam I W11 I Gar
- 35" ASUS ROG Swift PG35VQ curved GAMER monitor
- ÚJ Lenovo ThinkPad X13 Gen 5 - 13.3" WUXGA IPS - Ultra 5 135U - 16GB - 512GB - Win11 - 2,5 év gari
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest