-
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
válasz
Roxy27
#42998
üzenetére
Idézek a Téma összefoglalóból:
"Ne azt írd, hogy például az A oszlop szűrt adatait szeretnéd a C oszlopba másolni, ha valójában a B oszlop szűrt adatai kellenek egy másik lap X oszlopába."Ahhoz, hogy el tudjam küldeni a fájlt, újra be kellene vinnem mindent egy új füzetbe, mert természetesen nem mentettem el a feladatodat. Az eredmény az lenne, amit a képen látsz, a képből is kikövetkeztetheted a valódi megoldást. Nem véletlenül kértem az elrendezésedet, mert ahhoz kellett volna igazítanom a képleteket.
Mások is elkövetik ezt a hibát, hogy nem az eredeti felállást küldve kérnek segítséget, majd közlik, hogy másról van szó. Igazán érdekel, miért küldtél más formátumot, mint a valódi. Kérlek, írd meg!
Ha nem sikerül összehoznod, küldd el Te a fájlodat, akkor biztos leszek benne, hogy nem dolgozom duplán a képletekkel, és nem kell nekem bevinni az adatokat.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#42989
üzenetére
Függvény sem kell.
=vég_dátumot tartalmazó cella címe - kezdő_dátumot tartalmazó cella címe. -
Delila_1
veterán
válasz
zsolti_20
#42982
üzenetére
Óhajod parancs.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WF As WorksheetFunction
Application.EnableEvents = False
Set WF = Application.WorksheetFunction
ActiveSheet.Protect Password:="szupertitkosjelszó", UserInterfaceOnly:=True
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 5 Then Rows(Target.Row + 1).Locked = False
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 0 Then
Range("A" & Target.Row + 1 & ":E" & Target.Row + 1) = ""
Rows(Target.Row + 1).Locked = True
End If
Application.EnableEvents = True
End Sub -
Delila_1
veterán
válasz
zsolti_20
#42970
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WF As WorksheetFunction
Set WF = Application.WorksheetFunction
ActiveSheet.Protect Password:="szupertitkosjelszó", UserInterfaceOnly:=True
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 5 Then Rows(Target.Row + 1).Locked = False
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 0 Then Rows(Target.Row + 1).Locked = True
End SubEz azt csinálja, hogy ha pl. a 4. sor adatait törlöd, az 5. sor celláit zárolja. A 4. sor újra kitöltése után ismét írható lesz az ötödik.
Erre gondoltál? -
Delila_1
veterán
válasz
Szaszati
#42971
üzenetére
A nyers lapra vegyél fel két oszlopot. G1 legyen Hét, G2 képlete =HÉT.SZÁMA(C2).
H1 legyen Hét napja, H2 képlete =HÉT.NAPJA(C2). Ennek az oszlopnak a formátuma nnnn.
A kimutatásnál a szűrőkhöz Típust és a Hét oszlopokat vidd be, az oszlopokhoz a Hét napja kerül, a sorokhoz az Órák, Percek és Idő, az értékekhez kétszer az Összeg (összegként és mennyiségként).
A kész kimutatásban a Mennyiség/Összeg2 címet átírhatod Db-ra.Érdemes a nyers lapon az adatokat táblázattá alakítani – még a kimutatás létrehozása előtt –, akkor a kimutatásnál nem kell átírni a forrást a bővítéseknél, elég egy frissítést ráadni.
Szerk.: a nyers lapon törölheted az M oszlop tartalmát.
A szűrőkhöz a Dátum-ot is berakhatod. -
Delila_1
veterán
Sajnos ehhez a rendezési formához egyenként kell rendezni az egyes sorokat. A csatolt képen látszik, hogy a 19:21 sorokat úgy rendezi, hogy a 19. sor rendezését veszi elsődleges szempontnak, azután a 20-ast másodlagosnak, végül a 21-est.
Sor szerinti rendezésnél soronként kell megadni a rendezés szempontját. -
Delila_1
veterán
válasz
dreizwanzig
#42959
üzenetére
Tegyél autoszűrőt az oszlopra. Szűrd a 20-nál nagyobb értékekre. Jelöld ki a látható sorokat, és töröld.
-
Delila_1
veterán
válasz
zsolti_20
#42952
üzenetére
A teljes lapon zárolod a cellákat, majd levéded a lapot. Érdemes kivenni a pipát a Zárolt cellák kijelölése elől, ne is tudjon rálépni a következő sorra.
Rendeld a lenti makrót a lapodhoz (lásd a Téma összefoglalót).Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="szupertitkosjelszó", UserInterfaceOnly:=True
If Application.WorksheetFunction.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 5 Then
Rows(Target.Row + 1).Locked = False
End If
End SubEz a makró csak akkor szünteti meg a zárolást a KÖVETKEZŐ soron, mikor már minden adat megvan az A: E tartományban,
-
Delila_1
veterán
válasz
daddy9
#42948
üzenetére
A tiédben sem volt.

Az aktuális oszloptól BALRA lévőt fedte fel, amit az előző lépésben elrejtettél, ha éppen üres volt a 36. sor az oszlopban.
A második feltétel abszolút felesleges volt. Azt vizsgálta, hogy az aktuális oszloptól balra lévőben van-e adat, és ha igen, felfedte, de mivel az előző ciklusban nem rejtette el, hiszen nem volt üres, semmi szükség erre a sorra a makróban.
Mi az, hogy nyisson új oszlopot? Szúrjon be az aktuális oszloptól balra egyet? Melyik esetben? Ha az aktuális üres, vagy nem? -
Delila_1
veterán
válasz
daddy9
#42944
üzenetére
Ezt a makrót modulba kellene tenni, nem eseményvezéreltbe. Bár így is jó, bármelyik cellára kattintasz, lefut.
Modulba:Sub Rejt()
Dim LastColumn, i As Integer
Application.ScreenUpdating = False
LastColumn = 27 'Last Column
For i = 5 To LastColumn 'Lopping through each Column
If Cells(36, i) = "" Then
Columns(i).EntireColumn.Hidden = True
Else
Columns(i).EntireColumn.Hidden = False
End If
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
rudi666
#42932
üzenetére
Nem kell megnyitogatni. Kijelölöd a K oszlop tartományát, másolod (Ctrl+C), beállsz a gyűjtő füzet megfelelő lapján a megfelelő cellába.
Ha a képleteket akarod másolni – ez mindig a sok füzet celláinak az aktuális értékét adja –, akkor Ctrl+V-vel beilleszted a képleteket.
Ha a mostani értékeket akarod fixen beilleszteni a gyűjtő füzetbe, akkor irányítottan, értékként kell beillesztened a mostani adatokat.
Gondolom, csak a csatolt kép kedvéért vannak szövegként a képletek a K oszlopban, mivel aposztróffal kezdődnek. -
Delila_1
veterán
Úgy látom, állandó változásban van szegény makró. A másolás sorai
ide = Sheets(lapnev).Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("Munka2").Range("A" & sor & ":F" & sor).Copy Sheets(lapnev).Range("B" & ide)
Sheets("Munka2").SelectMár csak azt kell megmondanod, hogy az A: F tartományt a másik lap A-ba, vagy B-be tegye. Ha A-ba, akkor
Sheets("Munka2").Range("A" & sor & ":F" & sor).Copy Sheets(lapnev).Range("A" & ide)
kell neked. -
Delila_1
veterán
"ezután megvizsgálja a "munka2" lap A3 celláját és ha van olyan nevű munkalap már, akkor a B oszlop következő sorába bemásolja a tartalmát, ha nincsen a cellában szereplő nevű munkalap akkor létrehozza azt, és a B2 cellájába bemásolja a "munka2" lap A3-as
cellájának a tartalmát..."
Ebből nekem úgy tűnt, hogy az eredeti adat sorába kell másolni a B oszlop tartalmát.
Beteszek egy képet, kiemelve a módosításokat.
-
-
Delila_1
veterán
válasz
sosperec18
#42883
üzenetére
Legyen fejléce a táblázatodnak.
Állsz a táblázatban, Beszúrás | Kimutatás. Megadod a helyét vagy új lapon, ahogy felajánlja, vagy az aktuális lapon kijelölsz egy cellát, ahol kezdődjön.
Kapsz egy párbeszéd ablakot, ahol fent látszanak a táblázat címsorai. A Sorok, és az Értékek mezőbe is behúzod a neveket tartalmazó oszlop címét. Ennyi. -
Delila_1
veterán
Fferi gyorsabb volt, de azért én is beteszem a saját makrómat.
Sub Szetvalogatas()
Dim sor As Long, lapnev As String, usor As Long, a
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
lapnev = Right(Cells(sor, 1), Len(Cells(sor, 1)) - 3)
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number > 0 Then
Sheets.Add.Name = lapnev
Sheets(lapnev).Move After:=Sheets.Count
End If
Sheets(lapnev).Cells(sor, 2) = Sheets("Munka2").Cells(sor, 2)
Sheets("Munka2").Select
Next
Sheets("Munka2").Move After:=Sheets(1)
MsgBox "Kész a szétválogatás", vbInformation
End Sub -
Delila_1
veterán
Egy rövid makró a 36 kezdetű cellák másolásához.
Sub Masolas()
Dim sor As Long, ide As Long
Sheets("Munka2").Select
sor = 1
Do While Cells(sor, 1) <> ""
If Left(Cells(sor, 1), 2) = "36" Then
ide = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row + 1 '***
Sheets("Munka1").Cells(ide, 1) = Cells(sor, 1).Value
End If
sor = sor + 1
Loop
End SubA csillagokkal jelzett sor határozza meg a Munka1 lapon az első üres sort.
Sok adat esetén érdemes a makró elején kikapcsolni a képernyő frissítését –Application.ScreenUpdating = False
–, a végén meg visszaállítani.
Szerk.: azt is megteheted, hogy szűröd az oszlopot a 36-os kezdetre, majd a szűrt állományt másolod a Munka1-re. -
Delila_1
veterán
válasz
daddy9
#42788
üzenetére
Közben megadtad a választ arra, hogy ki mikor milyen oklevelet kap. Itt a módosított makró:
Sub Pdf()
Dim sor As Integer, oszlop As Integer, utvonal As String, FN As String
Application.ScreenUpdating = False
oszlop = 3
Do While Cells(4, oszlop) <> ""
utvonal = Cells(24, oszlop)
If Cells(7, oszlop) = "fiú" Then sor = 25 Else sor = 26
FN = Cells(sor, oszlop)
Sheets(Cells(sor, 1)).Select 'lapra állás
With Sheets("Adatbekérő")
Range("A7") = .Cells(6, oszlop) & ", " & .Cells(5, oszlop)
Range("A13") = .Cells(8, oszlop)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=utvonal & FN, _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
If .Cells(9, oszlop) = "Ügyes" Then
Sheets(.Cells(sor + 1, 1)).Select 'lapra állás
If .Cells(7, oszlop) = "fiú" Then sor = sor + 2 Else sor = sor + 1
FN = .Cells(sor, oszlop)
Range("A7") = .Cells(6, oszlop) & ", " & .Cells(5, oszlop)
Range("A13") = .Cells(8, oszlop)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=utvonal & FN, _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End With
Sheets("Adatbekérő").Select
oszlop = oszlop + 1
Loop
Application.ScreenUpdating = True
MsgBox "Az oklevelek el vannak mentve", vbInformation
End Sub -
Delila_1
veterán
válasz
csanyiadam
#42647
üzenetére
Szívesen.
-
Delila_1
veterán
válasz
csanyiadam
#42643
üzenetére
A lenti makrót modulba másolod. Kigyűjti egymás alá a címkéidet – mindegyikből csak egyet – a BJ oszlopba.
Sub Gyomlalas()
Dim sor As Long, usor As Long, oszlop As Long, ide As Long
usor = Range("C" & Rows.Count).End(xlUp).Row
ide = 1
For oszlop = 3 To 59 'BG oszlopig
For sor = 2 To usor
If Cells(sor, oszlop) <> "" Then
If Application.WorksheetFunction.CountIf(Columns(62), Cells(sor, oszlop)) = 0 Then
Cells(ide, 62) = Cells(sor, oszlop)
ide = ide + 1
Else
Exit For
End If
End If
Next
Next
End Sub -
Delila_1
veterán
válasz
csanyiadam
#42629
üzenetére
Fel kell venned egy egyéni listát. Beállítások | Speciális | Általános | Egyéni listák szerkesztése. Itt a Listaelemek ablakba egymás alá beviszed a címkéket a megfelelő sorrendben (egészség, sport, stb.), Hozzáad. Ezt megjegyzi az Excel.
Most a füzetedben a C oszlop tartalmát a Szövegből oszlopok funkció segítségével szétbontod külön cellákba a vesszők mentén.
Kijelölöd a C oszloptól a rendezendő adatokat addig az oszlopig, ameddig a címkéid tartanak.
Adatok | Rendezés és szűrés | Egyéni sorrend. A Beállításoknál a Balról jobbra opciót választod. A Rendezés rovatban (sajnos) egyenként be kell vinned a rendezendő sorokat az Újabb szint kiválasztásával. A Sorrend rovatban az Egyéni listát jelölöd be, ahol a bal oldalon kiválasztod a címkéid nevét tartalmazó listát.Egy kicsit körülményes amiatt, hogy a rendezendő sorokat egyenként kell megadni.
-
Delila_1
veterán
válasz
dogpatch06
#42613
üzenetére
=IF(AND(E6=0,F6=0),"",SUM(E$5:E6)-SUM(F$5:F6))A SUM-nál az E$6 helyett E6; az F$6 helyett F6 legyen. A $ jellel rögzítetted a befejező sort, ezért függőleges másolásnál megmaradt a 6. sorra való hivatkozás.
-
Delila_1
veterán
válasz
AndrewBlase
#42609
üzenetére
Szívesen.

-
Delila_1
veterán
válasz
AndrewBlase
#42607
üzenetére
P1-be
=DARAB(C3: C18) & " rendelés, " & SZUM(C3: C18) & " tétel"
persze a táblázatod oszlopaira hivatkozva. Szóközök nem kellenek. -
Delila_1
veterán
Vagy úgy formázod a cellát, ahogy ny.janos írta itt, vagy a formázandó cellán állva Feltételes formázás, Új szabály, A formázandó cellák kijelölése képlettel, majd az Értékek formázása, ha ez a képlet igaz rovatba beírod az általam javasolt képletet, csak éppen az A1 helyett annak a cellának a címét írod be, ahol a képlet van.Itt a kezdő egyenlőségjelet úgy kell értelmezni, mintha HA függvény lenne.
A képlet beírása után a Formátum gomb lenyomására kapsz egy új felületet, ahol megadod a kívánt formátumot (háttérszín, karakter típusa és színe, szegély). -
Delila_1
veterán
válasz
szente
#42546
üzenetére
Legegyszerűbben úgy, hogy MEGSZÜNTETED az összevont cellákat. Ehhez csupán 1 plusz oszlop kell a C elé. A címsor állhat 2 sorból, az A és B összevonható az első sorban (ezzel nem dolgozol később), a B2 Csapattag 1, a C2 pedig Csapattag 2.
Többször szerepelt itt a fórumon, hogy bár megengedi az Excel a cellák összevonását, de nem tudja maradéktalanul jól kezelni.
-
Delila_1
veterán
A csere funkcióval (Ctrl+h) cseréld a szóközöket semmire, majd a kigyomlált értékeket szorozd fel 1-gyel a következő módon. Egy üres cellába beírsz egy 1-est, amit másolsz Ctrl+c-vel. Kijelölöd a (még most is) szövegeket tartalmazó tartományt. Irányított beillesztés, a Műveletek csoportban jelöld be a szorzást. Az 1-est törölheted.
-
Delila_1
veterán
válasz
Nagyzoli27
#42453
üzenetére
Szívesen.
-
Delila_1
veterán
válasz
Nagyzoli27
#42448
üzenetére
Feltöltöttem
Nagyon sok volt a B oszlop üres cellája. Azzal kellett volna kezdenem, hogy az ezekhez tartozó ID-ket ki kellett volna törölnöm a D oszlopból a DARABTELI függvény segítségével. -
Delila_1
veterán
válasz
Nagyzoli27
#42448
üzenetére
Megnyitod mindkét füzetet, a cross.xlsx-re állsz, majd indítod a makrót.
Új hozzászólás Aktív témák
- A fociról könnyedén, egy baráti társaságban
- Tőzsde és gazdaság
- Autós topik
- Kertészet, mezőgazdaság topik
- RETRO beárazás (mobil, PC, konzol)
- Okos Otthon / Smart Home
- Andras-G: Az internet veszélyei [2. rész] - Facebook Marketpalce
- Elemlámpa, zseblámpa
- AMD GPU-k jövője - amit tudni vélünk
- Mesterséges intelligencia topik
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- 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!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Microsoft Surface Laptop 6 Ultra 7 165H 16 GB 2256X1504 Touch Garancia
- DAHUA 16GB DDR4 3200 MHz laptop RAM
- iPhone 15 128GB Black-1 ÉV GARANCIA - Kártyafüggetlen, MS3944, 100% AKKSI
- Dell Precision 3561 Core i9 11950H, 16-32GB RAM, 512GB SSD, jó akku, számla, 6 hó gar
- BESZÁMÍTÁS! 64GB Kingston Fury Renegade 2666Mhz DDR4 memória garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest







Fferi50