-
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
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
- Eladó jogtiszta, Windows 11/10, Office 2019/2021/2024, Fizikai és Digitális licencek, Számlával.
- MS SQL Server 2016, 2017, 2019
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Kingston HyperX IMPACT 32GB DDR4 2400 MHz laptop RAM (2x16GB)
- Óriás! Gamer PC-Számítógép! Csere-Beszámítás! R7 5700 / RTX 3080 / 16GB DDR4 / 512GB SSD!
- Dell Precision 7760 i7-11850H 64 GB RAM NVIDIA RTX A4000 FHD IPS Garancia
- BESZÁMÍTÁS! Gigabyte Aorus B560M i7 10700 32GB DDR4 1TB SSD RX 6600 XT 8GB ZALMAN i3 Edge EVGA 600W
- MiniITX GAMING PC! Ryzen 7700 / RTX 5070 / B850I / 32GB DDR5 / 2TB NVMe / 750w Gold! BeszámítOK
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50