-
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
-
-
Delila_1
veterán
Módosítottam a makrón. Mint írtam, nem szükséges a D oszlop, ami a két dátum között eltelt napokat számolja.
Sub Masolas()Dim sor As Integer, ide As IntegerSheets("Munka2").Columns("A:D").ClearContentsRange("A1:C1").Copy Sheets("Munka2").Cells(1) 'címsor másolásaSheets("Munka1").Selectide = 2: sor = 2Do While Cells(sor, 1) > ""If Cells(sor, 3) - Cells(sor, 2) >= 360 ThenRows(sor).Copy Sheets("Munka2").Range("A" & ide)Rows(sor).EntireRow.Deleteide = ide + 1: sor = sor - 1End Ifsor = sor + 1LoopEnd SubA Munka1 lapon az első sort magasabbra vettem, hogy rendesen elférjen a frissítő gomb. Ez egy alakzat (lekerekített sarkú téglalap, de lehet bármi más is), ehhez rendeltem a Masolas makrót.
Eredeti Munka1 lap:
A makró indítása után:
-
Delila_1
veterán
Egy másik módszer (nem kell hozzá segédoszlop).
Sub Masolas()Dim sor As Integer, usor As Integer, ide As IntegerSheets("Munka1").SelectRows(1).Copy Sheets("Munka2").Cells(1) 'címsor másolásausor = Range("A" & Rows.Count).End(xlUp).Rowide = 2For sor = 2 To usorIf Cells(sor, 3) - Cells(sor, 2) >= 360 ThenRows(sor).Copy Sheets("Munka2").Range("A" & ide)ide = ide + 1Rows(sor).EntireRow.DeleteEnd IfNextEnd Sub -
Delila_1
veterán
válasz
Dolphine
#52097
üzenetére
Ha például Dobos Kitti fölé akarsz beszúrni egy sort, akkor kijelölöd a sort A-tól G-ig, Ctrl+ –ra feljön egy kis párbeszéd ablak, ahol bejelölöd a Cellák eltolása lefelé négyzetet.
Törlésnél Ctrl- –ra jön a törlős ablak.
Függőleges kijelölésnél is működik ez a két lehetőség. -
Delila_1
veterán
-
Delila_1
veterán
válasz
föccer
#52074
üzenetére
Egy régebbi makró:
Sub Mappa_Valasztas()Dim FD, utvonal As StringMsgBox "Válasszunk magunknak útvonalat"Set FD = Application.FileDialog(4) 'mappa választásWith FD.AllowMultiSelect = False.ShowIf .SelectedItems.Count = 0 ThenMsgBox "Nem választottál útvonalat, befejezzük.", vbInformation, "Értesítés" Exit SubElseutvonal = .SelectedItems(1)End IfEnd WithMsgBox "A kiválasztott mappa: " & utvonal utvonal = utvonal & "\" 'jöhet a mentés, vagy megnyitásEnd SubNem jó amit Fferi, vagy én írtunk?
-
Delila_1
veterán
válasz
Vérboci
#52066
üzenetére
Írtam egy kis makrót, ami elvégzi az adatokat tartalmazó oszlopok láthatóságát.
Modulba kell bemásolnod (lásd az összefoglalóban a leírását).Sub Frissites()Dim oszlop As IntegerActiveSheet.PivotTables("Kimutatás1").PivotCache.Refresh 'Itt a saját kimutatásod nevét'írd a Kimutatás1 helyéreFor oszlop = 2 To 14If Application.WorksheetFunction.Sum(Columns(oszlop)) > 0 ThenColumns(oszlop).EntireColumn.Hidden = FalseElseColumns(oszlop).EntireColumn.Hidden = TrueEnd IfNextEnd SubA füzetet makróbarátként kell mentened.
A kimutatást tartalmazó lapra kitehetsz egy gombot, amihez hozzárendeled a Frissites makrót. Gombon jobb klikk, makró hozzárendelése. -
Delila_1
veterán
Táblázattá alakítod az adataidat (Beszúrás |Táblázat). Állsz a táblázatban, Táblázatkezelés | Eszközök | Szeletelő beszúrása. Egy ablakban megjelennek a címsoraid, bejelölöd az(oka)t, ami(ke)t szűrni akarsz, OK.
Bejelölöd az ikont a többszörös kijelölés lehetőségére a megjelenő szeletelőben, ahol egyszerűen kijelölheted a látni kívánt tételeket. -
Delila_1
veterán
válasz
dm1970
#52013
üzenetére
Könnyedén készíthetsz egyéni nézeteket.
Elrejted, amit kell, utána a Nézet | Munkafüzetnézetek | Egyéni nézetek ablakban Hozzáadás, és ellátod egy névvel.
Másik elrejtések, hozzáadás.
Ugyanitt ki tudod választani az éppen szükséges nézetet.Az Egyéni nézetek ikonon jobb klikk, hozzá tudod adni a gyorselérési eszköztárhoz. Akkor még nem is kell keresgélned a menüszalagon.
-
Delila_1
veterán
válasz
GabN73
#51995
üzenetére
Feltételezem, hogy nem a legújabb Excel verziótok van.
Az Adatok lapon vannak az eredeti adatok. Ezeket táblázattá alakítod (állsz a táblázatban, Beszúrás, Táblázat). Felveszed az új oszlopokat, ahova beviszed a képleteket az év, hónap, hét és nap meghatározásához.
A másik lap a Kimutatás névre hallgat. A táblázatban állva Beszúrás, Kimutatás. Meghatározod a helyét a Kimutatás lapon (nálam ez a G1 cella).Adatok lap:
Kimutatás lap a Szeletelő ismerete nélkül:

Kimutatás lap, ha ismeri a verziód a Szeletelő fogalmát:

-
Delila_1
veterán
válasz
KonzolKartel
#51992
üzenetére
Ha az adataid a 299. sorban kezdődnek, akkor a képletben is $H299 szerepeljen.
-
Delila_1
veterán
válasz
KonzolKartel
#51986
üzenetére
-
Delila_1
veterán
válasz
KonzolKartel
#51982
üzenetére
Szia!
Kijelölöd a teljes A:H tartományt, és feltételes formázást adsz rá. A képlet:
=$H2="státusz változás"(feltéve, hogy a 2. sorban kezdődnek az adataid), majd megadod a formátumot. Ügyelj a $ jelre. -
Delila_1
veterán
válasz
ElemiKoczka
#51963
üzenetére
Ja, azt elfelejtetted említeni, hogy a látszólagos számok ezres csoportosításban látszanak.
-
Delila_1
veterán
válasz
ElemiKoczka
#51961
üzenetére
Hogy?!
Muti egy képen. -
Delila_1
veterán
válasz
ElemiKoczka
#51956
üzenetére
Próbáld meg az ÉRTÉK függvénnyel.
-
Delila_1
veterán
válasz
ElemiKoczka
#51949
üzenetére
https://prohardver.hu/tema/excel/hsz_49013-49013.html
Itt a második bekezdésben leírtakat alkalmazhatod.
A szóközös helyett a szövegként szereplő számokat tartalmazó cellákra kell irányítottan beilleszteni az 1-est. -
Delila_1
veterán
válasz
istvankeresz
#51931
üzenetére
Szívesen.
-
Delila_1
veterán
válasz
istvankeresz
#51931
üzenetére
Az eredeti makródban meghatároztad az Ir változót, ami az utolsó (vagy az utolsót követő első üres) sor. Ezt használhatod fel a belső ciklusban.
For Each ws In ThisWorkbook.WorksheetsActiveWorkbook.Sheets("Maradék szabadságok").Cells(Ir,2) = ThisWorkbook.Sheets(ws.Name).Range("A2")Ir=Ir+1Next ws -
Delila_1
veterán
válasz
istvankeresz
#51927
üzenetére
Módosítottam az előzőt, nézd meg!
-
Delila_1
veterán
válasz
istvankeresz
#51927
üzenetére
Persze próba nélkül.oszlop=2For Each ws In ThisWorkbook.WorksheetsActiveWorkbook.Sheets("Maradék szabadságok").Cells(9,oszlop) = ThisWorkbook.Sheets(ws.Name).Range("A2")oszlop=oszlop+1Next ws -
Delila_1
veterán
válasz
istvankeresz
#51925
üzenetére
Az Ir értékét a For Each cell cikluson belül kell növelned.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#51915
üzenetére
Másik függvénnyel:
=HAHIBA(INDEX(C:AA;2;HOL.VAN("X";C3:AA3;0));"")
Lefelé másolhatod.Bocsi, nem Neked akartam címezni, hanem Win-T-nek.
-
Delila_1
veterán
válasz
DasBoot
#51899
üzenetére
Kiegészítettem bela85 linkelt makróját úgy, hogy a számokat emelkedő sorrendbe rakja.
Sub LottoSzamok()Dim Rng As Range, WorkRng As Range, xNumbers(49) As Integer, xTitleId As StringDim xIndex As Integer, xNum As Integer, Cim As Range, Lapnev As StringLapnev = Selection.Worksheet.NameOn Error Resume NextxTitleId = "Véletlen számok"Set WorkRng = Application.SelectionSet WorkRng = Application.InputBox("Melyik cellában kezdődjön?", xTitleId, WorkRng.Address, Type:=8)Set WorkRng = WorkRng.Range("A1")For xIndex = 1 To 49xNumbers(xIndex) = xIndexNextFor xIndex = 1 To 6xNum = 1 + Application.Round(Rnd * (49 - xIndex), 0)WorkRng.Offset(0, xIndex - 1).Value = xNumbers(xNum)xNumbers(xNum) = xNumbers(50 - xIndex)NextSet Cim = Range(WorkRng.Range("A1"), WorkRng.Offset(0, 5))Range(Cim.Address).SelectActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.ClearActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.Add2 Key:=Range(Selection.Address), _SortOn:=xlSortOnValues, Order:=xlAscendingWith ActiveWorkbook.Worksheets(Lapnev).Sort.SetRange Range(Selection.Address).Header = xlGuess.MatchCase = False.Orientation = xlLeftToRight.SortMethod = xlPinYin.ApplyEnd WithEnd Sub -
Delila_1
veterán
válasz
C.Brigante
#51852
üzenetére
poʇɐpuoɯlǝɾ ɐ zssɐlʞ
-
Delila_1
veterán
válasz
govl4545
#51840
üzenetére
Makró nélkül, képletekkel is meg lehet oldani. Ekkor nem kell makróbarátként menteni a fájlt.
B2:
=HA(DARABHA($E$1:$E$14;$A2)>0;INDEX($E$1:$G$14;HOL.VAN($A2;$E$1:$E$14;0);1);"")C2:
=HA(DARABHA($E$1:$E$14;$A2)>0;INDEX($E$1:$G$14;HOL.VAN($A2;$E$1:$E$14;0);2);"")D2:
=HA(DARABHA($E$1:$E$14;$A2)>0;INDEX($E$1:$G$14;HOL.VAN($A2;$E$1:$E$14;0);3);"") -
Delila_1
veterán
válasz
govl4545
#51840
üzenetére
Szia!
Egy makróval meg lehet oldani. Feltételeztem, hogy az első címsor, az adatok a 2. sorban kezdődnek.
A makrót modulba másold (lásd a téma összefoglalóban).Sub Parositas()Dim sorA As Integer, sorE As Integer, usor As Integerusor = Range("A" & Rows.Count).End(xlUp).RowsorA = 2: sorE = 2Do While sorA <= usorFor sorE = 2 To usorIf Cells(sorA, 1) = Cells(sorE, 5) ThenCells(sorA, 2) = Cells(sorE, 5)Cells(sorA, 3) = Cells(sorE, 6)Cells(sorA, 4) = Cells(sorE, 7)Cells(sorA, 1).Interior.ColorIndex = 6 '***Range("E" & sorE, "G" & sorE).Interior.ColorIndex = 6 '***Exit ForEnd IfNextsorA = sorA + 1LoopEnd SubAz eredmény:
A két csillagozott sort kihagyhatod, azok a háttérszínt állítják be.
A füzetet makróbarátként kell mentened. -
Delila_1
veterán
válasz
lacipapi
#51763
üzenetére
A cellán jobb klikk, Csatolás. A Hely mezőben kitallózód a fájlod helyét, nevét.
A Megjelenő szövegbe beírod azt a szöveget, amit a celládban látni szeretnél, majd OK.Egy link lesz a celládban, amire klikkelve betöltődik a pdf-ed. Csatolhatsz így más típusú (kép, Excel, doc, stb.) fájlokat is.
-
Delila_1
veterán
Akkor nem kell a szeletelő, egy makróval megoldható.
Alt+F11-re bejön a VBA szerkesztő. Beszúrsz egy modult: Insert, Module.
A jobb oldalon kapott nagy üres felületre bemásolod a makrót.Sub Filterek()Dim Nevek(), usor As IntegerActiveSheet.ListObjects("Táblázat1").Range.AutoFilter Field:=1usor = Range("N" & Rows.Count).End(xlUp).RowNevek = Application.Transpose(Range("N3:N" & usor))ActiveSheet.ListObjects("Táblázat1").Range.AutoFilter Field:=1, Criteria1:= _Array(Nevek()), Operator:=xlFilterValuesEnd SubA füzetbe visszalépve Alt+F8-ra megjelennek a füzetben lévő makrók (ha több is van), indítod a Filterek címűt. Az N oszlop aktuális címeire szűri a táblázatodat.
A füzetet makróbarátként, xlsm kiterjesztéssel kell mentened. -
Delila_1
veterán
válasz
Vérboci
#51741
üzenetére
Alt+F11-gyel belépsz a VBA szerkesztőbe. Bal oldalon kiválasztod a lapodat, a beállításoknál (Properties) a ScrollArea tulajdonságnál beállítod a területet, ahonnan nem akarsz kilépni.
A képen az A : D terület van megadva,
Szerk.: sajnos ezt minden megnyitáskor újra be kell állítani, hacsak megnyitáshoz nem írsz egy rövid makrót, a ThisWorkbook laphoz rendelve. Ekkor makróbarátként kell mentened a füzetet.

-
-
Delila_1
veterán
-
Delila_1
veterán
válasz
karlkani
#51576
üzenetére
Itt egy még egyszerűbb megoldás, ami – mint az általad belinkelt is – megtartja a feltételes formázásokat.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.Color = xlNoneColumns(Target.Column).Interior.ColorIndex = 20Rows(Target.Row).Interior.ColorIndex = 20End Sub -
Delila_1
veterán
válasz
excelkerdes
#51572
üzenetére
A belinkelt makró az aktuális cellát (amire kattintottál) szálkeresztbe teszi. Függőleges és vízszintes színes cellák mutatják, hol állsz.
A makrót a lapodhoz kell rendelni, ennek a módja az Összefoglalóban le van írva. -
Delila_1
veterán
válasz
excelkerdes
#51570
üzenetére
Jó régen volt erről szó, [itt], nézd meg az előzményeit is.
-
Delila_1
veterán
válasz
Dark Archon
#51504
üzenetére
Az A2-ben 1 van, és nincs színezve. A3-ba írd be: =A21+1. Ezt már másolhatod.
-
Delila_1
veterán
válasz
Dark Archon
#51502
üzenetére
Pedig lappy 5-ös módszere megfelel.
-
Delila_1
veterán
válasz
minimumgame
#51453
üzenetére
Új hozzászólás Aktív témák
- Víz- gáz- és fűtésszerelés
- sziku69: Szólánc.
- Luck Dragon: MárkaLánc
- Samsung Galaxy Watch7 - kötelező kör
- Projektor topic
- Diablo IV
- exHWSW - Értünk mindenhez IS
- Gyártófüggetlen H170/Z170 (LGA1151) alaplapok topicja
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Gamer egerek és billentyűzetek kitűnő árakon!
- LG 34GX90SA - 34" Ívelt Smart OLED / QHD 2K / 240Hz & 0.03ms / 1300 Nits / NVIDIA G-Sync / FreeSync
- MSI GeForce RTX 3090 VENTUS 3X OC 24GB GDDR6X 384bit
- Dell Precision 7550 i7-10850H 32GB 1TB Nvidia RTX3000 6GB 1 év garancia
- Apple iPhone 15 256GB,Átlagos,Adatkabel,12 hónap garanciával
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest









