Hozzászólások
-
SzerzőBejegyzés
-
Email-ben?
Szívesen.Szia!
A laphoz kell rendelned egy eseménykezelő makrót. Lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutottál a VB szerkesztőbe, az adott laphoz.
A kapott üres oldalra másold be.Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 2) = Date End Sub
Ebben a makróban ha az A oszlopba írsz [Colums=1], akkor a B oszlopba az azonos sorba [Cells(Target.Row, 2] beírja fixen a mai dátumot.
A füzetet makróbarátként kell mentened.Delila
2024-03-07-15:43 Hozzászólás: [Resolved] Két táblázat adatainak beillesztése és táblázat átméretezése #10537Szándákosan értékeket másoltam a Feladat lapra, a sok képlet lassítja a futást (sok sornál).
Egy hiba is volt a makrómban, a Csoport (2) oszlopba az 5. sortól vittem be a Munka2 lap adatait.
A mostani makróban csak az F (Fűz) oszlopban vannak képletek, hogy megmutassam, miként lehet tartományba képleteket bevinni.
Ezt a makrót is meghívhatod a lapjaidról az adatok változásakor.Sub Masolas() Dim tabla As Range, usor As Integer, ide As Integer Sheets("Feladat").Select Range("C5:H1500").ClearContents 'előző adatok törlése Sheets("Munka1").Select 'Értékek másolása a Munka1 lapról usor = Range("B5").End(xlDown).Row Range("B5:B" & usor).Copy Range("C5").PasteSpecial xlPasteValues Range("B5:C" & usor).Copy Sheets("Feladat").Range("C5").PasteSpecial xlPasteValues Range("F5:F" & usor).Copy Sheets("Feladat").Range("E5").PasteSpecial xlPasteValues ide = Sheets("Feladat").Range("C" & Rows.Count).End(xlUp).Row + 1 Sheets("Munka2").Select 'Értékek másolása a Munka2 lapról usor = Range("B5").End(xlDown).Row Range("B5:B" & usor).Copy Range("C5").PasteSpecial xlPasteValues Range("B5:C" & usor).Copy Sheets("Feladat").Range("C" & ide).PasteSpecial xlPasteValues Range("G5:G" & usor).Copy Sheets("Feladat").Range("F" & ide).PasteSpecial xlPasteValues Application.CutCopyMode = False Sheets("Feladat").Select usor = Range("C" & Rows.Count).End(xlUp).Row 'összefűző képlet a Fűz oszlopba Range("G5:G" & usor) = "=E5 & F5" End Sub
2024-03-06-12:43 Hozzászólás: [Resolved] Két táblázat adatainak beillesztése és táblázat átméretezése #10531Szia!
Próbáld meg ezzel:Sub Masolas() Dim tabla As Range, usor As Integer, ide As Integer Sheets("Feladat").Select Set tabla = Range("C5").CurrentRegion tabla.Offset(1, 0).Resize(tabla.Rows.Count - 1, tabla.Columns.Count).ClearContents Sheets("Munka1").Select usor = Range("B5").End(xlDown).Row Range("B5:B" & usor).Copy Range("C5").PasteSpecial xlPasteValues Range("B5:C" & usor).Copy Sheets("Feladat").Range("C5").PasteSpecial xlPasteValues Range("F5:F" & usor).Copy Sheets("Feladat").Range("E5").PasteSpecial xlPasteValues ide = Sheets("Feladat").Range("C" & Rows.Count).End(xlUp).Row + 1 Sheets("Munka2").Select usor = Range("B5").End(xlDown).Row Range("B5:B" & usor).Copy Range("C5").PasteSpecial xlPasteValues Range("B5:C" & usor).Copy Sheets("Feladat").Range("C" & ide).PasteSpecial xlPasteValues Range("G5:G" & usor).Copy Sheets("Feladat").Range("F5").PasteSpecial xlPasteValues Application.CutCopyMode = False Sheets("Feladat").Select End Sub
Üdv,
DelilaSzívesen. 🙂
Szia!
A Jegyzék lapon felveszünk egy segédoszlopot, ami megkeresi a Forduló lap C2:C5; D2;D4 … G2>G5 tartományban a Jegyzék A2 értékének a sorát.
Ezután a Jegyzék B2 cellájában az INDEX függvény kihozza a keresett nevet.Üdv,
DelilaSzerk: találtam egy hibát. Ha senki nem végezte valamelyik munkát, akkor hibás az eredmény. A Jegyzék lap B2 cellájának a képlete legyen =HA(G2=0;””;INDEX(Forduló!$A$2:$G$5;G2;1)), ezt másold le a többi sorba.
Attachments:
You must be logged in to view attached files.Szia!
Írtam egy makrót.Sub osszefuzes() Dim sor As Integer, szoveg As String sor = 2 Do While Cells(sor, 1) <> "" If Cells(sor, 1) <> Cells(sor - 1, 1) And Cells(sor, 1) <> Cells(sor + 1, 1) Then Cells(sor, 3) = Cells(sor, 2): sor = sor + 1 End If If Cells(sor + 1, 1) = Cells(sor, 1) Then If szoveg = "" Then szoveg = Cells(sor, 2) szoveg = szoveg & "]-[" & Cells(sor + 1, 2) Else Cells(sor, 3) = szoveg szoveg = "" End If sor = sor + 1 Loop End Sub
Alt+F11-re bejön a VB szerkesztő. Itt beszúrás (insert), modul (module). A jobb oldalon kapott üres felületre bemásolod a makrót. Makróbarátként kell elmentened a füzetet.
A jobb áttekinthetőség kedvéért minden azonosítónál csak az alsó sorba írattam ki az eredményt.
Indítás a füzetben: az Alt+F8-ra megjelenő ablakban indítod az osszefuzes nevűt.Üdv,
DelilaA feltételek közé tedd be az útja szót is.
A hosszú képlet az út; u.; tér; utca; és köz szavakat vizsgálja.
A dátumkénti megjelenítés gáz.Szia!
A képen (is) láthatod a képletet.
=HA(NEM(HIBÁS(SZÖVEG.KERES("út";A1)));KÖZÉP(A1;SZÖVEG.KERES("út";A1)+3;20);HA(NEM(HIBÁS(SZÖVEG.KERES("u.";A1)));KÖZÉP(A1;SZÖVEG.KERES("u.";A1)+3;20);HA(NEM(HIBÁS(SZÖVEG.KERES("tér";A1)));KÖZÉP(A1;SZÖVEG.KERES("tér";A1)+4;20);HA(NEM(HIBÁS(SZÖVEG.KERES("utca";A1)));KÖZÉP(A1;SZÖVEG.KERES("utca";A1)+5;20);KÖZÉP(A1;SZÖVEG.KERES("köz";A1)+4;20)))))
Attachments:
You must be logged in to view attached files.2023-10-18-06:37 Hozzászólás: [Resolved] Központi mappából PDF beillesztése fájlnév alapján – VBA segítségével #10194🙂
2023-10-15-05:28 Hozzászólás: [Resolved] Központi mappából PDF beillesztése fájlnév alapján – VBA segítségével #10192Bocsáss meg, „csak” a lényeget nem írtam meg. A makrót ahhoz a laphoz kell rendelned, ahol működtetni akarod.
Lapfülön jobb klikk, Kód megjelenítése. Ezzel bejutsz a VB szerkesztőbe, ott is a lapod lesz kiválasztva. Jobb oldalon a nagy üres felületre másold a makrót.
A Module1-et törölheted.Biztosan jó a „D:\D:\NIN\Excel_tippek\PDF_gyujto\” útvonal? Kétszer szerepel a meghajtó neve.
2023-10-14-13:38 Hozzászólás: [Resolved] Központi mappából PDF beillesztése fájlnév alapján – VBA segítségével #10189Szia!
Itt a makró:
Private Sub Worksheet_Change(ByVal Target As Range) Dim utvonal As String, FN As String If Target.Column = 1 And Target.Row > 3 Then Application.EnableEvents = False utvonal = "D:\Gyűjtő mappa útvonala\" '*************************** FN = Target.Value & ".pdf" ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, 1), Address:= _ utvonal & FN, _ TextToDisplay:=FN Application.EnableEvents = True End If End Sub
A csillagokkal jelzett sor végén ne hagyd ki a \ jelet!
Üdv,
DelilaSzia!
Legyen a cellaformátum hh.nn, majd rendezd az oszlopot. Visszaállíthatod a formátumot éé.hh.nn-ra.
A kérdésnek a második részét nem értem.Delila
Szia!
Makrós megoldást küldök. Felvettem egy új lapot az átalakításhoz, a neve „Munka1 (2)”.
A makró „Sortoresek” címre hallgat.
(Nem találom itt az egyes szövegrészek kiemelésének a formai lehetőségét, ezért idézőjelbe tettem a kiemelendő részeket.)Delila
Attachments:
You must be logged in to view attached files.Még egyszerűbb stoppolás:
A Sub sornál a bal oldalon lévő szürke sávra kattintasz. A teljes sor barna hátterű lesz, és csak akkor halad tovább a makró futása, ha F8-at nyomsz.NINnek
Igen, el lehet hagyni az Application.EnableEvents sort, és a visszaállítását, de nem érdemes.
Stoppold le az első sort, majd a B oszlopba íráskor lépésenként futtasd a makrót.
Mikor a makró beírja a nevet a megfelelő oszlopba, előről indul, mivel a Cange eseményre ezt kell tennie. Igaz, a feltételnél nem csinál semmit,
mert nem a B oszlopban volt most a csere. Ezután újra indul a futás, ott folytatva, ahonnan kilépett.
Ha letiltod, majd a feladat végeztével újra engedélyezed az esemény kezelését, megspórolhatod ezt a kört.Szia!
Több leírást adtál a feladatra, én erre írtam egy makrót:
Az “A” oszlop kitöltése után, a “B” oszlopban beállítom – számszerűsítve ( 0-3 , vagy ha a 0 nem értelmezhető, akkor 1-4 ig – , hogy a “C” oszlophoz képest mennyivel tolja el és írja ki az “A” oszlopban szereplő szöveget.Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 And Cells(Target.Row, 1) <> "" And IsNumeric(Target) Then Application.EnableEvents = False Cells(Target.Row, 3 + Target.Value) = Cells(Target.Row, 1) Application.EnableEvents = True End If End Sub
Beírod az A oszlopba a szöveget. Mikor az azonos sor B oszlopában megadod az eltolás mértékét, a C-hez képest annyi oszloppal jobbra is megjelenik az A oszlop szövege.
A makrót a lapodhoz kell rendelni. Lapfülön jobb klikk, Kód megjelenítése. Ezzel belépsz a VB szerkesztőbe. A jobb oldalon lévő üres mezőbe bemásolod a fent megadott makrót.Delila
Szia!
A Ctrl+F6 bill.kombináció a következő lapra visz, kódja
ActiveWindow.ActivateNext
.
A CTRL+Shift+F6 az előző lapot teszi aktívvá, kódjaActiveWindow.ActivatePrevious
.
Készíthetsz egy lapra tartalomjegyzéket, ahol csatolással beviszed a lapok nevét, és az ugrás helyét, az egyes lapokra pedig szintén csatolással a tartalomjegyzék lapra ugrást.Delila
Szia!
Meg lehet írni, de szerintem sokkal egyszerűbb a 3 oszlopra feltételes formázást adni, ami feltűnő háttérszínt ad a kitöltetlen celláknak.
Üdv
DelilaSzia!
Nem látom a diagramnál a zárolt tulajdonság beállíthatóságát – valószínűleg egyes verzióknál van rá mód –, de ha a lapvédelemnél nem jelöljük be az Objektumok szerkesztése rovatot, nem szerkeszthetjük.
Delila
Szia!
Ha az adatrendezést úgy érted, hogy a Munka1 lap kikeresett értékeit beírod a Munka2 lap megfelelő soraiba, ill. oszlopaiba, akkor ezt javaslom:
Sub Ciklus() Dim tol As Integer, ig As Integer, ide As Integer, keres As Integer Sheets("Munka1").Select ide = 0 For keres = 20 To 2500 Step 50 tol = keres: ig = keres + 50 ide = ide + 1 FKeres tol, ig, ide Next End Sub Sub FKeres(tol, ig, ide) Sheets("Munka2").Cells(ide, 1) = Application.WorksheetFunction.VLookup("X", Range("P" & tol & ":Q" & ig), 2, 0) Sheets("Munka2").Cells(ide, 2) = Application.WorksheetFunction.VLookup("Y", Range("P" & tol & ":Q" & ig), 2, 0) Sheets("Munka2").Cells(ide, 3) = Application.WorksheetFunction.VLookup("Z", Range("P" & tol & ":Q" & ig), 2, 0) End Sub
A VLOOLUP a P:Q tartományban keres, a Q értékét adja vissza.
Delila
Szia!
Jelöld ki együttesen a két lapot, szúrd be az oszlopot, majd a második lapról töröld.
Delila
Gyorsan írtam minden sorhoz magyarázatot a makróban. Feltöltöm az új verziót. Egy kicsit egyszerűsítettem a makrón.
Attachments:
You must be logged in to view attached files.Szia!
Küldök egy makrós megoldást. Ide csak becsomagolva lehet feltenni a makróbarát füzeteket, a zip fájl kibontása után indíthatod a Start gombbal.
Most el kell mennem, de ha megfelel, később elmagyarázom a működését.Üdv,
DelilaAttachments:
You must be logged in to view attached files.Részemről szívesen. 🙂
Igen, jól látod a cellák összevonásának a hátrányát.
Egészen furcsa dolgokat kaphatsz, ha pl. nem a címsorban, hanem az adatsorok között van itt-ott összevonás, és szűröd a tartományt.Kedves egészségedre!
Szia!
Nem olyan sok, 6 IF kell hozzá. Viszont lehet egyszerűsíteni.
Sub Health_Data_Fresh() With Sheets("service2") If .Range("bz2") <> .Range("ca1") Then .Range("bx6") = .Range("bz3") * .Range("ch6") .Range("bx7") = .Range("bz3") * .Range("ch7") .Range("bx8") = .Range("bz3") * .Range("ch8") .Range("bx9") = .Range("bz3") * .Range("ch9") .Range("bx10") = .Range("bz3") * .Range("ch10") .Range("bx11") = .Range("bz3") * .Range("ch11") If .Range("ci6") - .Range("bx6") <= 0 Then .Range("ci6") = 0 Else .Range("ci6") = .Range("ci6") - .Range("bx6") If .Range("ci7") - .Range("bx7") <= 0 Then .Range("ci7") = 0 Else .Range("ci7") = .Range("ci7") - .Range("bx7") 'stb. End If .Range("bz3") = .Range("ca1") End With End Sub
Delila
A Korábbi időpont és a Későbbi időpont címekhez összevontad a cellákat. Beírod a B1-be a szöveget, majd kijelölöd a B1:D1 tartományt. A cellaformázásnál a vízszintes elrendezésnél a Kijelölés közepére opciót választod.
A szorzások azért kellenek, mert a jobb, bal és közép függvények eredménye szöveg, de ha felszorozzuk 1-gyel, vagy hozzáadunk nullát, számként értelmezi az Excel a továbbiakban.
Csak az első két, adatokat tartalmazó sort formáztam.
A Korábbi időpont és a Későbbi időpont címekhez összevontad a cellákat. Beírod a B1-be a szöveget, majd kijelölöd a B1:D1 tartományt. A cellaformázásnál a vízszintes elrendezésnél a Kijelölés közepére opciót választod.
A szorzások azért kellenek, mert a jobb, bal és közép függvények eredménye szöveg, de ha felszorozzuk 1-gyel, vagy hozzáadunk nullát, számként értelmezi az Excel a továbbiakban.
Jogos a két pont!
Ezt elnéztem.Szia!
Bevittem egy új lapot, másolat címen.
Delila
Attachments:
You must be logged in to view attached files.Mikor az első makrót tettem be ide, ezt írtam: Az A oszlopod ne legyen zárolt.
Neked kell a lap zárolása előtt az írható oszlopok védelmének a megszüntetése.Átírtam a makrót.
Kérlek, tiszteld meg a fórumot azzal, hogy a hozzászólás elküldése előtt átnézed az írásodat, és csak a hibák kijavítása küldd azt el.
Nem tudok mit kezdeni az ilyen sorokkal: Tudom bocsolult a kérésem, de talán megoldható.Attachments:
You must be logged in to view attached files.Szia!
Egyszer már megírtam az Excel-program_v2.xlsm fájlban, hogy ne duplázd az adatokat. Nálad teljesen azonos adatok szerepelnek a két lapon.
Semmi szükség az ide-oda hivatkozásokra.Az érvényesítéshez szükséges adatokat – mivel összesen 3 van belőlük – a kép szerint is megadhatod, akkor nem lesz a tartomány útban.
Makrót tartalmazó füzetet tömörítve tudsz ide belinkelni.
Attachments:
You must be logged in to view attached files.Teszt?! 🙂
Szívesen.Ezt kérted:
Pl.: “A1” cellába beviszek egy adatot, akkor a “B1” cellába kiírja az év-hónap-nap óra:perc -et.
Véletlenül a perc (minut) helyett másodpercet (seconds) adtam meg a formátumnál. Öreg hiba, mea culpa!A
Cells(Target.Row, Target.Column + 1) = Format(Now, "yyyy.mm.dd hh:ss")
sorban a formátumot írd át így:
Cells(Target.Row, Target.Column + 1) = Format(Now, "yyyy-mm-dd hh:mm")
Ennél már az év-hó-nap közötti pontot is átírtam a kérésed szerinti kötőjelre.Szia!
Ha már Imre felajánlotta, megírtam a makrót. 😀
Az A oszlopod ne legyen zárolt.
A lapodhoz kell rendelned: lapfülön jobb klikk, Kód megjelenítése. A jobb oldalon megjelenő üres felültre másold be a makrót.
AActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True
sorban most aaa a lapvédelem jelszava, ezt írd át kedved szerint. Ez a sor teszi lehetővé makróból a zárolt cellák felülírását.Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Cells(Target.Row, 2) = "" Then Application.EnableEvents = False ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True Cells(Target.Row, 2) = Format(Now, "yyyy.mm.dd hh:ss") Application.EnableEvents = True End If End If End Sub
Lehet, hogy a makróban lévő idézőjeleket át kell írnod. Ha piros színnel jelenik meg nálad egy sor, ez a teendő.
Üdv, Delila
Remek!
Szia!
Felveszel egy segédtáblát, ami nálam az I:J oszlopokban van. A címsort kihagyva nevet adsz, itt Tartomány. Mivel táblázattá alakítottam, a későbbi bővítések automatikusan benne lesznek a Tartományban.
A képletet látod a D oszlopban. Amennyiben nincs a Tartomány-ban a címzett neve, a HAHIBA függvény eredménye „egyéb” lesz.Delila
Attachments:
You must be logged in to view attached files.Szívesen.
Már tudod, miket kell átírnod a makrókban.
Option Explicit
Public kepszam As IntegerSub Start() Cells(1) = "OK" kepszam = 1 Kepek End Sub
Sub Kepek() Const utvonal = "D:\Jpg\Új\" If Cells(1) = "OK" Then Application.OnTime Now + TimeSerial(0, 0, 2), "Kepek", , True ActiveSheet.Shapes.Range("Alakzat").Fill.UserPicture utvonal & kepszam & ".jpg" End If kepszam = kepszam + 1 If kepszam > 7 Then kepszam = 1 End Sub
Sub Abbhagy() Cells(1) = "Stop" End Sub
A Start és az Abbhagy makrókat 1-1 gombhoz rendelheted.
- A hozzászólás módosításra került: 1 year, 1 month telt el-delila.
Nézd meg újra a makrót, amit küldtem, és csak ott változtass, ahol a megjegyzésekben írtam.
Szia,
Sub Kepek() Dim kepszam As Integer, utvonal As String Application.OnTime Now + TimeSerial(1, 0, 0), "Kepek", , True kepszam = Application.WorksheetFunction.RandBetween(1, 7) 'ahány képed van utvonal = "D:\Jpg\Új\" 'saját útvonaladat add meg ActiveSheet.Shapes.Range("Alakzat").Fill.UserPicture utvonal & kepszam & ".jpg" 'saját alakzatod nevét add meg End Sub
A képek neve sorszám legyen. 1.jpg, 2.jpg, stb.
Delila
- A hozzászólás módosításra került: 1 year, 1 month telt el-delila. Indok: Képnevek
Szia!
A feladattól függ a megoldás.
A munkalap ScollArea tulajdonságához beírtam: $A:$C
Ezzel elértem, hogy lapvédelem nélkül csak az első 3 oszlopba lehet kattintani. Egy makró megadja, hogy a C oszlopba beírt adattal (jelenleg számmal) történjen a D oszlopban egy művelet, amit a makró által előállított képlet hajt végre.Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 3 Then Application.EnableEvents = False Cells(Target.Row, 4) = "=3*" & Target.Value Application.EnableEvents = True End If End Sub
Delila
Szia!
Laphoz rendelt makró.
Ha csak egy ugrást akarsz létrehozni, elég 1 sor:
If Target.Address=”$A$10″ Then Range(„A15”).SelectA Select Case utasításokkal több ugrást megadhatsz.
Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$A$10": Range("A15").Select Case "$B$4": Range("B10").Select Case "$D$6": Range("D3").Select Case "$E$4": Range("b10").Select Case "$E$12": Range("F5").Select End Select End Sub
Delila
Azt hiszem, addig már eljutottál, hogy az M oszlopban vannak az adatok, amik számjegyeket, és max 1 db kötőjelet tartalmaznak. Az L oszlopban azok az adatok vannak, amiknek az első 3 karakterét kell a kötőjelek helyére tenni az M-ben.
A lenti makró az O oszlopba ír egy képletet, ami létrehozza az általad kívánt eredményt. Ezt értékként beilleszti az M oszlopra, az ideiglenes O oszlopot törli.Sub Segedoszlop_O() Range("O2:O15").FormulaR1C1 = _ "=IFERROR(LEFT(RC[-2],SEARCH(""-"",RC[-2])-1)&LEFT(RC[-3],3)&RIGHT(RC[-2],LEN(RC[-2])-SEARCH(""-"",RC[-2])),RC[-2])" Columns(15).Copy Range("M1").PasteSpecial xlPasteValues Columns(15).Delete End Sub
Szia!
Használd az autoszűrőt, és a RÉSZÖSSZEG függvényt!
Delila
Igazad lehet. Megeshet, hogy például „\,” szerepel némelyik cellában. Az összes adat ismeretében meg kell találnod a helyes sorrendet.
Csak az fontos, hogy a több vessző törlése előbb legyen, mint a kevesebbé. Érthető lesz, ha végig gondolod a logikáját.
Igazad van, gyorsabb a REPLACE függvénnyel.
Sub CsereBere() Dim ido As Date usor = Range("M" & Rows.Count).End(xlUp).Row Range("M1:M" & usor).Replace What:=",,,,,,,,", Replacement:="," Range("M1:M" & usor).Replace What:=",,,", Replacement:="," Range("M1:M" & usor).Replace What:=",,", Replacement:="," Range("M1:M" & usor).Replace What:="_", Replacement:="," Range("M1:M" & usor).Replace What:="-", Replacement:="," Range("M1:M" & usor).Replace What:="\", Replacement:="," Range("M1:M" & usor).Replace What:="/", Replacement:="," Range("M1:M" & usor).Replace What:=" ", Replacement:="," MsgBox Format(Now - ido, "mm:ss") End Sub
Szia!
Nálam a felülírandó adatok a B oszlopban vannak, segédoszlopként a C-t használom – amit a végén törlök.
55.000 sorral 12 másodperc alatt végzett.Sub Csere() Dim usor As Long, ido As Date ido = Now usor = Range("B" & Rows.Count).End(xlUp).Row Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""\"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""/"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],"" "","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""_"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],""-"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],"",,,,,,,,"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],"",,,"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Range("C1:C" & usor).FormulaR1C1 = "=SUBSTITUTE(RC[-1],"",,"","","")" Range("C1:C" & usor).Copy Range("B1").PasteSpecial xlPasteValues Columns(3).Delete MsgBox Format(Now - ido, "mm:ss") End Sub
Delila
Nem tudom, miért nem enged simán másolni, de a txt beiktatásával klassz megoldás. Köszönöm.
Igen, bőven elég lett volna az FKERES függvény.
Nálam a 2019-es verzióban a tömb bemásolását csak úgy tudtam megoldani, hogy előbb szövegként elmentettem egy txt fájlba.Szia!
Az A oszlop tartalmát átmásoltam a G-be, majd az Ismétlődések eltávolítása funkcióval kitöröltem a felesleges sorokat. A H oszlop tartalmazza a beírandó szövegeket. Az új tartomány a G1:H32. A C oszlopba írtam a képletet.
Delila
Attachments:
You must be logged in to view attached files.Szia!
Az általad C-nek nevezett tartomány a C oszlopban van, a D pedig a D oszlopban, mindkettő az első sorban kezdődik.
Private Sub Cbo_A_Change() Dim usor As Long Select Case Cbo_A.Value Case Is = "Számlák" usor = Range("C" & Rows.Count).End(xlUp).Row Cbo_B.RowSource = "Munka1!C1:C" & usor Case Is = "Egyéb" usor = Range("D" & Rows.Count).End(xlUp).Row Cbo_B.RowSource = "Munka1!D1:D" & usor End Select End Sub
Delila
Szia!
Két példa az első üres sor meghatározására, jelenleg az A oszlopban.
Sub ElsoUres() Dim usor As Long usor = Range("A" & Rows.Count).End(xlUp).Row + 1 MsgBox usor usor = Application.WorksheetFunction.CountA(Columns(1)) + 1 MsgBox usor End Sub
Innen már be tudod vinni az adatot, pl. cells(usor, 1)= …
Nem jelent meg a táblázatod. Valószínűleg makróbarát füzetet akartál belinkelni, de ez a fórum csak tömörítetten fogadja el.A lapvédelem beállításakor engedélyezd az AutoSzűrő használatát.
Szia!
A címsor ne legyen zárolt.
Tedd ki a gyorselérési eszköztárra az autoszűrő ikonját (tölcsér alakú), erre kétszer kattintva megoldódik a gondod.
Az első kattintás megszünteti a szűrőket a címsorban, a második visszateszi a már szűretlen tartományhoz.Üdv,
DelilaAz általam küldött Teszt_1-import.zip füzet Alap (2) lapján ezt csinálja a makró. Most nem írom át az 5-e előtti 4 sor beszúrásához, azt „gyalog” is megteheted. 🙂
A Pihenőnap szöveg beírásához kijelölöd a Időelem h. szövege oszlopot az alsó adatig. F5-re bejön az Ugrás menü, ott Irányított, majd Üres cellák. Ez kijelöli az üreseket. Nem változtatsz a kijelölésen, hanem beírod a Pihenőnap szöveget, és Ctrl+ Enterrel viszed be egyszerre az összesbe.
Indítod a makrót. Mikor leáll a hibaüzenettel, Alt+F11-gyel belépsz a VB szerkesztőbe. A kurzort a hibás sorban (sárga hátterű) a sor változó fölé viszed, ami megmutatja a hibás sor számát. Azzal már tudsz valamit kezdeni. Leállítod a makrót (az eszköztáron a négyszögletes stop gombbal), majd a füzetben a Riport_2 lapon kikeresed azt a sort.
El tudom képzelni, hogy valamelyik hónapban az összeg nem szám, hanem számnak látszó szöveg.Vagy: tömöríted a fájlodat, és beteszed ide.
Nem tudom, miért nincsenek ott a makrók. Bemásolom ide.
Alt+F11-re bejön a VB szerkesztő. Bal oldalon kiválasztod a füzetedet (ha van több is megnyitva), az Insert-Module kiválasztására kapsz egy új modult bal oldalon, Module1 névvel. A jobb oldali nagy üres mezőbe másold be ezeket:Sub Osszesites() Dim lap As Integer, uoszlop As Integer, usorR As Long, lapnev As String Sheets("Riport_2").Cells.Delete Sheets(2).Range("A1:E1").Copy Sheets("Riport_2").Range("A1") For lap = 2 To Worksheets.Count If Left(Sheets(lap).Name, 6) <> "Riport" Then uoszlop = Sheets("Riport_2").Cells(1, Columns.Count).End(xlToLeft).Column + 1 usorR = Sheets("Riport_2").Range("A" & Rows.Count).End(xlUp).Row + 1 With Sheets(lap) Sheets(1).Cells(1, uoszlop) = "Hátralék " & .Name usor = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:E" & usor).Copy Sheets(1).Range("A" & usorR) .Range("F2:F" & usor).Copy Sheets(1).Cells(usorR, uoszlop) End With End If Next Rendez uoszlop End Sub Sub Rendez(uoszlop) Sheets("Riport_2").Select usor = Range("A" & Rows.Count).End(xlUp).Row ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("B1:B" & usor), _ SortOn:=xlSortOnValues, Order:=xlAscending ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("D1:D" & usor), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("Riport_2").Sort.SortFields.Add2 Key:=Range("A1:A" & usor), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Riport_2").Sort .SetRange Range(Cells(2, 1), Cells(usor, uoszlop)) .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Egyesites uoszlop End Sub Sub Egyesites(uoszlop) Dim oszlop As Integer Sheets("Riport_2").Select usor = Range("A" & Rows.Count).End(xlUp).Row uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column For sor = usor To 3 Step -1 If Cells(sor, 1) = Cells(sor - 1, 1) And Cells(sor, 2) = Cells(sor - 1, 2) _ And Cells(sor, 4) = Cells(sor - 1, 4) Then For oszlop = 6 To uoszlop Cells(sor - 1, oszlop) = Cells(sor, oszlop) + Cells(sor - 1, oszlop) Next Rows(sor).Delete End If Next Cells.EntireColumn.AutoFit End Sub
A felsőt kell indítanod, az meghívja a másik kettőt.
Szia!
Írtam egy makrót, ami elkészíti az összesítést.
A csatolt füzetben az Osszesites makrót kell indítanod.Üdv,
DelilaAttachments:
You must be logged in to view attached files.Szia!
Az Alap lapra bevittem, amit az Eredmény lapon összeállítottál.
Nem tudom, miért akarod beszúrni a hiányzó dátumokat, de írtam hozzá egy kis makrót – ezért makróbarát a fájl. Az „Alap (2)” lapon indítva beszúrja a sorokat, és beírja a hiányzó dátumokat.
Üdv,
Delila- A hozzászólás módosításra került: 1 year, 5 months telt el-delila.
Attachments:
You must be logged in to view attached files.Ahogy a videón láttad:
=INDEX(A1:A6,MODE(MATCH(A1:A6,A1:A6,0)))
Szia!
Magyar Excelnél a képlet
=INDEX(A1:A6;MÓDUSZ(HOL.VAN(A1:A6;A1:A6;0)))
Delila
Beírod az adatokat. Formázás táblázatként, kiválasztod a stílust, Fejléceket tartalmazó táblázat. Adja a Táblázatn nevet, amit felülírhatsz, de ilyen mennyiségnél egyszerűbb a sorszámmal hivatkozni az egyes táblázatokra.
Jó reggelt!
Csatolom az INDEX függvényes megoldást.
Delila
Attachments:
You must be logged in to view attached files.Szia!
Nem vagyok Imre, de azért megpróbálok segíteni.
Az A1:A10 feltételes formázási képlete legyen=SZUM($B1:$H1)>0
Üdv,
DelilaSzia!
A makró elején add ki a parancsot, ami a makrónak engedélyezi a zárolt cellákba írást:
ActiveSheet.Protect Password:="SzuperTitkosJelszó", UserInterfaceOnly:=True
Üdv,
DelilaHurrá!
Szia!
Nézd meg az FKERES függvényt, erre való.
Delila
Most már sokkal jobb a formázás.
A szűrőt a helyedben az 5. sorba tenném az első helyett, akkor még hasznát is vehetnéd.Szia!
Imre fájlján a feltételes formázást átírtam 1 szabályra. Szerintem nem kell a zöld háttér, elég, ha a hibás cellák pirosak.
Nézd meg az X15-ös cellát, ott van egy hibás érték.Delila
Attachments:
You must be logged in to view attached files.Szia!
Próbáld így:
If Cells(i, j).FormatConditions(1).Interior.ColorIndex = 3 Then Cells(i, j).FormatConditions(1).Interior.ColorIndex = 5
A lényeg a FormatConditions.Delila
Örülök, hogy haladsz a feladattal.
Nem sikerült időben kijavítani.
A C2 képlete rövidebben:
=HA(VAGY(ÜRES(B2);TÍPUS(B2)<>1);"Nincs számadat";HA(B2=MEDIÁN(B2;$J$2;$J$3);"OK";"Nem OK"))
Szívesen. Remélem, sikerrel átalakítottad a saját igényedhez.
Szia!
Az Index és a HOL.VAN függvényekkel tudod megoldani.
A 2 fájlt becsomagoltam, az Ország Kalkuláció.xlsx Munka1 lapján, az A1 cellában találod a képletet. Nem írtam melyik fájlban milyen oszlopok vannak, de a képletet átírhatod a minta alapján.Delila
Attachments:
You must be logged in to view attached files.A csatolt füzeted C oszlopa jól van formázva, de be kell vinned egy új feltételt a 0 alatti értékekre:
=C15<0
Nézd meg a névkezelőt, van egy halom érvénytelen tartományod.A sárga formázást ki kell egészítened.
=ÉS(VAGY(C2<5;C2>7);HOSSZ(C2)>0;C2<>"")
Ehhez azt kell tudni, hogy a képletet tartalmazó cella hosszát az Excel 0-ként értelmezi.Az előző verziódat vettem figyelembe. A mostani számokhoz nyilván át tudod alakítani a képletek számértékeit.
A sárgánál a <5 feltétel tartalmazza az üres értéket is, azért kell betenni feltételként, hogy erre ne vonatkozzon. A zöldnél fix az 5 és 7 között nem lehet üres cellaérték.
Szia Sándor!
Két képlet kell a C oszlopba.
=ÉS(VAGY($C2<5;C2>7);C2<>"")
– sárga, és=ÉS(C2>=5;C2<=7)
– zöld. Az össze többi felesleges.
Ugyanez megy az A oszlopra is, csak ott a képletekben C helyett A szerepeljen.- A hozzászólás módosításra került: 1 year, 10 months telt el-delila.
Szívesen. 🙂
Szia!
Ha nevet adtál a tartománynak, a RowSource =Lapnév!Tartománynév.
Ha nem adtál nevet, akkor =Lapnév!Tartomány_első_tagja:Tartomány_utolsó_tagja.
A form indításaUserForm1.ListBox1.ListIndex = (0) UserForm1.Show
Ide csak tömörítve tudod becsatolni a makrót tartalmazó fájlodat.
Delila
Szia!
A ThisWorkbook laphoz rendeld a makrót. A csillagozott sorban állíthatod be, hogy melyik napon másoljon.
Private Sub Workbook_Open() If Day(Date) = 10 Then '********* Columns(4).Copy Range("E1").PasteSpecial xlPasteValues End If End Sub
Azt biztosan meg tudod adni, hogy ha a hónap megadott napja hétvégére esik [WeekDay(Date,2]>5, akkor a következő hétfőn másoljon.
Szívesen.
Küldöm módosított verziót, megint mesével.Attachments:
You must be logged in to view attached files.Addig ügyeskedtem, míg sikerült innen kitörölnöm a tömörített fájlt. Azt hittem, lehet több csatolmány, de nem.
Attachments:
You must be logged in to view attached files.Elírtam a „mese” szövegében egy szót, csatolok a javítottról egy képet.
Attachments:
You must be logged in to view attached files.Szia!
Makróval nagyon gyorsan létre lehet hozni a sok jelölőnégyzetet.
Csatoltam a makróbarát füzetet, tömörítve, mert csak így fogadja el a fórum.
Mese a fájlban.Delila
Szia!
Alapállásban adj valami háttérszínt a kitöltendő celláknak, majd adj rájuk feltételes formázást.
=A1<>""
– ha A1 a kötelezően kitöltendő cella.
A formátum megadásánál a kitöltés legyen Nincs kitöltés.Delila
Szívesen. 🙂
Szia!
A képlet
=HA(ÉS(C3>=0;C3<=2);C3*A$1;HA(ÉS(C3>2;C3<=5);C3*A$2;C3*A$3))Delila
Szia Imre!
Mivel az időpontok (feltehetően) emelkedő sorrendben vannak, egyszerűbben is meghatározható a Max és Min érték.
Delila
Attachments:
You must be logged in to view attached files.Örülök, hogy végül összejött.
Szia!
Eszerint nem 1, hanem több oszlop tartalma szerint kell szűrnöd a táblát.
A képen látod a G2 cella képletét, amit a többi sorra is lemásolhatsz. Ezután a G oszlopra kell szűrni azokat a sorokat, ahol az érték nagyobb, mint nulla.
A makró így módosul:
ActiveSheet.Range("$A$1:$G$20").AutoFilter Field:=7, Criteria1:=">0"
Attachments:
You must be logged in to view attached files.Jó reggelt!
Lehet, hogy az F oszlop számokat tartalmaz, a H1 pedig számként ábrázolt szöveget (vagy fordítva).
Próbáld meg, hogy a H1-be áthúzol egy cellát az F oszlopból.Az ActiveSheet.Unprotect helyett olyan utasítást javaslok, ami a makrónak engedi a lapon a módosítást az amúgy zárolt cellákban, de a billentyűzetről nem.
A Select utasítások sem kellenek.Sub Felt_Szures() ActiveSheet.Protect Password:="SzuperTitkosJelszó", UserInterfaceOnly:=True ActiveSheet.Range("$A$1:$F$20").AutoFilter Field:=6, Criteria1:=Range("$H$1") End Sub
Szia!
Igen, lehet.
ActiveSheet.Range("$A$1:$F$6").AutoFilter Field:=5, Criteria1:=Range("N1")
Itt az A1:F6 tartomány E oszlopát szűrjük az N1 cella tartalma szerint. Ide írhatsz relációs jeles értéket is, pl. <=500,
vagy a T* tartalomnál a T-vel kezdődő adatokra kapsz szűrést.Üdv,
Delila -
SzerzőBejegyzés