Hirdetés
- Kormányok / autós szimulátorok topikja
- Házi barkács, gányolás, tákolás, megdöbbentő gépek!
- Milyen asztali médialejátszót?
- Fejhallgató erősítő és DAC topik
- Fujifilm X
- Épített vízhűtés (nem kompakt) topic
- Gaming notebook topik
- Melyik tápegységet vegyem?
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Milyen processzort vegyek?
-
PROHARDVER!
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
Lackukac
#8846
üzenetére
Két makró lehetővé teszi, hogy az A oszlopot bővítve, vagy szűkítve minden külön gombnyomás nélkül létrejöjjön a B oszlopban a szűrt listád.
Az elsőt a laphoz kell rendelned: lapfülön jobb klikk, Kód megjelenítése, a VB szerkesztőben (ahova most bejutottál) a jobb oldalon kapott üres lapra másold be.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Application.EnableEvents = False
Range("J1") = Range("A65000").End(xlUp).Row
Columns("B:B") = ""
Lista_Szűrő
Application.EnableEvents = True
End If
End SubA szerkesztőben maradva bal oldalon kattints a füzeted nevére. Insert menü, Module. Kapsz bal oldalon egy Module1 nevű modult, ehhez másold be jobb oldalra a második makrót.
A J1 cellába írja be a makró az A oszlop mindenkori utolsó sorát, és felhasználja a szűrésnél.
Sub Lista_Szűrő()
ActiveWorkbook.Names.Add Name:="Lista", RefersToR1C1:= _
"=OFFSET(Munka1!R1C1,0,0,Munka1!R1C10,1)"
Range("Lista").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"D1:D2"), CopyToRange:=Range("B1"), Unique:=False
End SubAz "=OFFSET(Munka1!R1C1,0,0,Munka1!R1C10,1)" sorban a félkövérrel írt munkalap nevet írd át a saját lapod nevére.
Új hozzászólás Aktív témák
- Humble szökevények 500-1500Ft
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Eladó Steam kulcsok kedvező áron!
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- 201 - Lenovo Yoga Slim 7 (15ILL9) - Intel Core U7 258V, no GPU (ELKELT)
- HIBÁTLAN iPhone 15 128GB Pink-1 ÉV GARANCIA - Kártyafüggetlen, MS4510
- Új Razer Blade 16 QHD+ OLED 240Hz i9-14900HX 24mag 32GB 1TB Nvidia RTX 4080 12GB 175W Win11 Garancia
- HIBÁTLAN iPhone SE 2020 64GB Black-1 ÉV GARANCIA - Kártyafüggetlen, MS4001
- Mio Star 8750B Automata kávégép 6 hónap Garancia Beszámítás Házhozszállítás
Állásajánlatok
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50

