Hirdetés
- sziku69: Fűzzük össze a szavakat :)
- Luck Dragon: Asszociációs játék. :)
- Lalikiraly: Mercis kalandok - Huszonnyolcadik rész - Az újrakezdés
- Luck Dragon: MárkaLánc
- sziku69: Szólánc.
- Sapphi: StremHU | Source – Self-hostolható Stremio addon magyar trackerekhez
- MasterDeeJay: Intel Optane M10: mire lehet használni?
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- gban: Ingyen kellene, de tegnapra
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
-
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
-
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
- BESZÁMÍTÁS! AsRock H510M i5 11400 16GB DDR4 512GB SSD RTX 2070 Super 8GB Formula Air Mesh G3 600W
- LG UltraWide 35WN75CP IPS Monitor! sRGB 99% / 3440x1440 / 100Hz / 5 ms / FreeSync! BeszámítOK!
- Azonnali készpénzes AMD Ryzen 1xxx 2xxx 3xxx 5xxx processzor felvásárlás személyesen / csomagküldés
- BESZÁMÍTÁS! Asus Dual RTX 3070 Ti 8GB OC videókártya garanciával hibátlan működéssel
- Sapphire Pulse RX 9070XT új, felbontott // Számla // Garabcia //
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50