-
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
-
senior tag
Végül kb megoldottam magam egy vba makró modullal:
Sub Szines_kereso()
Dim ws As Worksheet
Dim xRg As Range
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant
Dim cellaszin As Long
' Munkalap inicializálása
Set ws = ThisWorkbook.Sheets("Munkalap")
Do
xVrt = Application.InputBox(prompt:="Keresés: (Kilépéshez hagyja üresen és kattintson az OK-ra) ", Title:="Keresőablak találati színezéssel")
If xVrt <> "" Then
Set xFRg = ActiveSheet.Cells.Find(what:=xVrt)
If xFRg Is Nothing Then
MsgBox prompt:="A keresett érték nem található", Title:="Keresőablak találati színezéssel"
Exit Sub
End If
xStrAddress = xFRg.Address
Set xRg = xFRg
Do
Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
Set xRg = Application.Union(xRg, xFRg)
Loop Until xFRg.Address = xStrAddress
If xRg.Count > 0 Then
cellaszin = xRg.Interior.ColorIndex
xRg.Interior.ColorIndex = 8
ws.Rows(xRg.Row).Select ' Ha találtunk valamit, ugorjunk a megtalált cella sorához
xRsp = MsgBox(prompt:="Akarja törölni a talált cella színezését?", Title:="Keresőablak találati színezéssel", Buttons:=vbQuestion + vbOKCancel)
If xRsp = vbOK Then xRg.Interior.ColorIndex = cellaszin 'cella háttérszín visszaállítása
End If
End If
Loop Until xVrt = "" ' Do ciklus záróeleme
End Sub
Új hozzászólás Aktív témák
- Samsung Galaxy Z Flip5 - ami kint, az van bent
- AMD Ryzen 9 / 7 / 5 / 3 5***(X) "Zen 3" (AM4)
- HiFi műszaki szemmel - sztereó hangrendszerek
- Androidos fejegységek
- Linux - haladóknak
- Kodi és kiegészítői magyar nyelvű online tartalmakhoz (Linux, Windows)
- War Thunder - MMO Combat Game
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Parfüm topik
- Motorola Moto G24 Power - hol van az erő?
- További aktív témák...
- Steam, Windows, Origin kulcsok, előfizetések közvetlenül a kiadótól, a LEGJOBB ÁRON!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Eredeti Windows, telepítéssel! Digital Doctor Számítógép Szerviz
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.