Hirdetés
- Ezek a OnePlus 12 és 12R európai árai
- A kameraszenzor és az aksi is nőtt a Nubia Z70S Ultrában
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Honor Magic6 Pro - kör közepén számok
- iPhone topik
- Yettel topik
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Okosóra és okoskiegészítő topik
- One mobilszolgáltatások
- Milyen okostelefont vegyek?
-
Mobilarena
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
Tsabee #28987 üzenetére
Javaslom, hogy a ThisWorkbook lapra a 2. makrót másold, ami az RGB színeket tartalmazza.
Neked kell összeállítani a segédtáblát. Mivel soronként 32 adatod van, a táblázatot az AN oszlopban kezdd, ahogy a képen látod.
Természetesen az AN oszlopba a saját számaidat írd, és a saját ízlésed szerint színezd. Mikor kész a segédtábla az N oszlopig, ráállsz az első (AN3) cellára, és indítod a SzínLekerdezes makrót. Ilyen üzenetet kapsz:
Egyenként minden számodhoz írd be a kódokat a megfelelő helyekre.
A laphoz rendelt makró változik:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sor As Long
If Target.Column > 1 And Target.Column <= 33 Then
On Error Resume Next
sor = Application.Match(Target, Columns(40))
If VarType(sor) = vbError Then
Exit Sub
Else
Range(Target.Address).Interior.Color = RGB(Cells(sor, "AO"), Cells(sor, "AP"), Cells(sor, "AQ"))
Range(Target.Address).Font.Color = RGB(Cells(sor, "AR"), Cells(sor, "AS"), Cells(sor, "AT"))
End If
End If
End SubA sorszámok ismétlésének a módját már leírtam.
A képen látható B1:F1 tartomány számait a makró színezte ki, én csak beírtam.
-
Delila_1
veterán
válasz
Tsabee #28983 üzenetére
Pontosabb, egyéni színkódokat is beállíthatsz. Az első makró helyett legyen
Sub SzinLekerdezes()
Dim Rh As Integer, Gh As Integer, Bh As Integer
Dim Rk As Integer, Gk As Integer, Bk As Integer
Dim hatter, karakter
hatter = Selection.Interior.Color
karakter = Selection.Font.Color
Rh = hatter Mod 256
Gh = (Int(hatter / 256)) Mod 256
Bh = Int(hatter / 256 ^ 2)
Rk = karakter Mod 256
Gk = (Int(karakter / 256)) Mod 256
Bk = Int(karakter / 256 ^ 2)
MsgBox "Háttér RGB: " & Rh & ", " & Gh & ", " & Bh & vbLf & _
"Karakter RGB: " & Rk & ", " & Gk & ", " & Bk
End Suba második helyett pedig ez
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sor As Long
If Target.Column = 1 Then
On Error Resume Next
sor = Application.Match(Target, Range("N:N"))
If VarType(sor) = vbError Then
Exit Sub
Else
Range(Target.Address).Interior.Color = RGB(Cells(sor, "O"), Cells(sor, "P"), Cells(sor, "Q"))
Range(Target.Address).Font.Color = RGB(Cells(sor, "R"), Cells(sor, "S"), Cells(sor, "T"))
End If
End If
End SubEhhez a segédtáblát is bővítened kell.
Az A6 cella 86-os értéke az előző makrókkal készültek, ott nem tudta hozni az egyéni háttérszínt.
-
Delila_1
veterán
válasz
Tsabee #28983 üzenetére
Kezdjük az egyszerűbbel. Beírod a sorszámokat 1-től 7-ig. Mivel nem adtad meg, hol kellenek ezek a számok, az A1-ben kezdtem. Az A8 képlete =A1, ezt másolhatod, ameddig kell.
A másikhoz 2 makró szükséges.
Alt+F11-gyel belépsz a makró szerkesztőbe. Bal oldalon kiválasztod a füzetedet, ott is a ThisWorkbook lapot. A jobb oldalon kapott nagy fehér felületre bemásolod a makrót:Sub Szin_lekerdezes()
MsgBox "Háttér színkód: " & Selection.Interior.ColorIndex & vbLf & _
"Karakter színkód: " & Selection.Font.ColorIndex
End SubEz azt csinálja, hogy kiírja egy üzenetben az aktív cella hátterének, és karakterének a színkódját.
Összeállítasz egy segédtáblát, ahol az első oszlop tartalmazza a bevihető, színezendő számokat, a 2. oszlop a háttér-, a 3. a karakter színkódja lesz. Nálam ez a segédtábla az N:P oszlopokban van. Az N oszlopban beállítod a kívánt 2 színt, majd ráállsz az első számra, és indítod a fenti makrót (Alt+F8-ra megjelenő ablakban). A két kapott értéket beírod a megfelelő helyre. Ezt egyszer kell végig zongoráznod.Most jön a bevitt számok cellájának az automatikus színezése.
Azt sem írtad meg, hova viszed be ezeket a számokat. A lenti makró az A oszlopba beírt számok celláját színezi. Ezt a makrót a lapodhoz kell rendelni. Lapfülön jobb klikk, újra a VB szerkesztőben vagy, abban is a lapodhoz tartozó üres felület jelent meg a jobb oldalon. Oda kell bemásolnod a kódot:Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
On Error Resume Next
Range(Target.Address).Interior.ColorIndex = _
Application.WorksheetFunction.VLookup(Target, Range("N:P"), 2, 0)
Range(Target.Address).Font.ColorIndex = _
Application.WorksheetFunction.VLookup(Target, Range("N:P"), 3, 0)
End If
End SubEzzel kész az előkészület.
Mikor beírsz egy számot az A oszlopba azok közül, amiket a segédtáblában megadtál, a kedvenc színösszeállításodra színezi a cellát. Olyan szám beírásánál, ami nem szerepel a segédtáblában, marad az eredeti háttér- és karakterszín.Kép hozzá:
Új hozzászólás Aktív témák
- AMD Navi Radeon™ RX 9xxx sorozat
- exHWSW - Értünk mindenhez IS
- Azonnali alaplapos kérdések órája
- Clair Obscur: Expedition 33 teszt
- Diablo IV
- Milyen egeret válasszak?
- Milyen videókártyát?
- A fociról könnyedén, egy baráti társaságban
- Luck Dragon: Asszociációs játék. :)
- Robot fűnyírók
- További aktív témák...
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Grand Theft Auto GTA Vice City PC
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- LG 55CS6 - 55" OLED - 4K 120Hz 1ms - NVIDIA G-Sync - FreeSync Premium - HDMI 2.1 - PS5 és Xbox!
- Amazon Kindle 10th Generation ébresztős tok
- BESZÁMÍTÁS! Apple Macbook Pro 16" 2019 i9 9980HK 64GB 500GB Radeon Pro 5500M hibátlan működéssel
- Samsung Galaxy A23 128GB, Kártyafüggetlen, 1 Év Garanciával
- BESZÁMÍTÁS! MSI B450M R5 5500 16GB DDR4 512GB SSD ROG RX VEGA 56 8GB Rampage SHIVA Thermaltake 530W
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: Laptopszaki Kft.
Város: Budapest