-
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
-
Fferi50
Topikgazda
Szia!
Ez a makró azt tudja, hogy az M1,N1 cellákba beírt címek alapján megszámolja a színek számát és kiírja az O1 cellába.Sub CountCcolor1()
Dim cel As Range, cminta As Range, cter As Range, countcl As Long
Dim xcolor As Long
Set cter = Range(Range("M1").Value)
If cter.Cells.Count = 1 Then
Set cminta = cter: Set cter = Range(Range("N1").Value)
Else
Set cminta = Range(Range("N1").Value)
End If
countcl = 0
xcolor = cminta.DisplayFormat.Interior.ColorIndex
For Each cel In cter.Cells
If cel.DisplayFormat.Interior.ColorIndex = xcolor Then
countcl = countcl + 1
End If
Next cel
Range("O1").Value = countcl
End Sub
Az M1-be kell a vizsgálandó terület címe (Pl. A1 : D5), az N1-be kell a mintacella címe (pl.K4), vagy fordítva, fontos, hogy a mintacella egy cella legyen.7
Természetesen mindhárom cella címét (M1, N1, O1) átírhatod a neked megfelelőre. Fontos még, hogy ezek a cellák azon a munkalapon legyenek, ahol számoltatni szeretnél és onnan indítsd a makrót - amit természetesen akár egy gombhoz is hozzárendelhetsz.
Üdv.
Üdv.
Új hozzászólás Aktív témák
- Magga: PLEX: multimédia az egész lakásban
- BestBuy topik
- Milyen autót vegyek?
- Mozilla Firefox
- Milyen videókártyát?
- Drága Bluetooth tagek olcsóbb alternatívái (MiLi MiTag, LiTag, OTAG, stb.)
- Poco F6 5G - Turbó Rudi
- Milyen TV-t vegyek?
- Az 5 legnagyobb bénázás a mobilpiacon idén
- Xiaomi 15T Pro - a téma nincs lezárva
- További aktív témák...
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Eladó Steam kulcsok kedvező áron!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- GYÖNYÖRŰ iPhone 13 mini 128GB Starlight -1 ÉV GARANCIA -Kártyafüggetlen, MS3893
- BESZÁMÍTÁS! Asus H370 i7 8700 16GB DDR4 512GB SSD RTX 2060 Super 8GB Zalman S2 TG Cooler Master 650W
- HP ProDesk 600 G4 i5-8100 16GB 512GB 1 év garancia
- BESZÁMÍTÁS! Huawei Watch 4 Pro eSIM okosóra garanciával hibátlan működéssel
- AKCIÓ!!! HP ZBook Power 15 G8 Mobile Workstation i7-11850H 32GB 1000GB Nvidia RTX A2000
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest
Fferi50
