Hirdetés
- Luck Dragon: Asszociációs játék. :)
- btz: Internet fejlesztés országosan!
- Mr.Csizmás: Bestbuy travel, utazós, kirándulós topic - szállások, jegyek
- sziku69: Fűzzük össze a szavakat :)
- Ndruu: Segíts kereshetővé tenni a PH-s arcképeket!
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Doky586: SecureBoot kulcsok frissítése (2026 nyara)
- potyautas: Olyan valóságosnak tűnt
- ricsi99: 6. Genes alaplap tündöklése kontra MS/Zintel korlátozásai
- Hieronymus: Az igaz barátság kezdete
-
LOGOUT
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
válasz
Doki16
#43864
üzenetére
Szia!
Bekapcsolod az autoszűrőt. A két oszlopra külön-külön csinálsz szín szerinti szűrést a sárga cellákra.
A C oszlopba a képlet:
Amikor az első oszlopot szűröd:
=A2 (az első látható cella az A oszlopban)
Amikor a második oszlopot szűröd:
=B3 (az első látható cella a B oszlopban)
A képletet végighúzod az érvényes szűrő alatt a látható cellákon.
Utána megszüntetheted a szűrést.Üdv.
-
Guitar14
senior tag
válasz
Doki16
#43864
üzenetére
Helló!
Nézet fülben kattints a makrókra, csinálj újat és szerkeszd aztán töröld ki üresre és illeszd be ezt:Function SumByColor(CellColor As Range, rRange As Range)
'Dim cSum As Long
Dim ColIndex As Integer
ColIndex = CellColor.Interior.ColorIndex
For Each cl In rRange
If cl.Interior.ColorIndex = ColIndex Then
cSum = WorksheetFunction.Sum(cl, cSum)
End If
Next cl
SumByColor = cSum
End Function
Mentsed le makróbarát munkafüzetként valahová, azt nyisd meg és írd be így a képletet:
(megpróbáltam replikálni a táblád
)
Lényeg, hogy ami nekem kék színnel van arra egy olyat rögzíts $ jelekkel előtte ami olyan színü amilyen adat kell tehát egy sárga cellát jelölj meg vele, aztán húzd le a képletet és kész.
-
lappy
őstag
válasz
Doki16
#41477
üzenetére
egy vba
Sub ColorCompanyDuplicates()
'Updateby Extendoffice 20160704
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Excel"
Exit Sub
End If
On Error GoTo 0
Next
End Sub
Új hozzászólás Aktív témák
Hirdetés
- iPhone topik
- Új CPU-magokka, de régebbi PowerVR GPU-val jöhet a Tensor G6
- Fejhallgató erősítő és DAC topik
- A fociról könnyedén, egy baráti társaságban
- War Thunder - MMO Combat Game
- Yettel topik
- Debrecen és környéke adok-veszek-beszélgetek
- Gyúrósok ide!
- Győr és környéke adok-veszek-beszélgetek
- Multimédiás / PC-s hangfalszettek (2.0, 2.1, 5.1)
- További aktív témák...
- Eladó jogtiszta, Windows 11/10, Office 2019/2021/2024, Fizikai és Digitális licencek, Számlával.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Microsoft és egyéb dobozos és OEM szoftverek
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Telefon felvásárlás!! iPhone 13 Mini/iPhone 13/iPhone 13 Pro/iPhone 13 Pro Max/
- Eladó egy Xiaomi 11t pro 256/8 snapdragon processor
- UGREEN 3x1 HDMI Switch
- 4 db Lenovo LOQ (17IRX10) - Intel Core i7-13700HX, RTX 5060
- LENOVO ThinkPad T14s Gen 2 touchscreen - i7-1185G7, 16GB RAM, SSD, jó akku, számla, 6 hó gar
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

)
Fferi50