-
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
p5quser #36959 üzenetére
A laphoz rendelt gomb csak a saját lapján tud dolgozni. Helyette tegyél a lapra (mondjuk az elsőre) egy alakzatot, pl. a lekerekített téglalapot.
Modulba másold be a makrót:
Sub Szures()
Dim lap As Integer
Application.ScreenUpdating = False
For lap = 2 To Sheets.Count
Sheets(lap).Select
ActiveSheet.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:=">1"
ActiveSheet.AutoFilter.Range.Select
Selection.Interior.Color = 5296274
' ActiveSheet.Range("$A$1:$N$330").AutoFilter Field:=11 'összes sor mutatása
Next
' Sheets(1).Select 'első lapra állás
Application.ScreenUpdating = True
End SubAz alakzathoz rendeld hozzá a Szures makrót. Ez a másodiktól az utolsó lapig halad, és mindenhol végrehajtja a szűrést, színezést.
Nézd meg, kell-e a két sor a makróban, amikhez megjegyzést fűztem.
-
Pakliman
tag
válasz
p5quser #36959 üzenetére
Szia!
Nem próbáltam ki, mert dokinál vagyok, de mennie kellene:Sub CommandButton2_Click()
'Kijelölés
Dim ws as worksheet
Dim act as worksheet
Set act=activesheet
For each ws in worksheets
If not ws is act then
Ws.activate
Ws.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlAnd
Ws.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Ws.ShowAllData
Ws.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:="<-1", _
Operator:=xlAnd
Ws.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Ws.ShowAllData
Ws.Range("$A$1:$N$316").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlOr, Criteria2:="<-1"
Endif
Next ws
End Sub
(Baromi nehéz telefonon írni)
Új hozzászólás Aktív témák
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- AMD Catalyst™ driverek topikja
- Vége a gamer PC-knek? Cloud Gaming 2025-ben
- Flip (IPTV, otthoni internet, vezetékes telefon)
- PlayStation 1 / 2
- Kés topik
- AMD Navi Radeon™ RX 9xxx sorozat
- Nintendo Switch 2
- Melyik tápegységet vegyem?
- Spórolós topik
- További aktív témák...
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Game Pass Ultimate előfizetések 4 - 19 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- MS SQL Server 2016, 2017, 2019
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Xbox Game Pass Ultimate előfizetések kedvező áron
- DELL PowerEdge R730xd 26SFF rack szerver - 2xE5-2680v3 (24c/48t, 2.5/3.3GHz), 64GB RAM, 10G, H730p
- Apple iPhone 16 Pro Max Desert Titanium Titán dizájn, Pro kamera 256 GB Használt, karcmentes
- Telefon felvásárlás!! iPhone 12 Mini/iPhone 12/iPhone 12 Pro/iPhone 12 Pro Max
- Azonnali A320 B350 X370 B450 X470 A520 B550 X570 chipset alaplap felvásárlás személyes/csomagküldés
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest