- Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Keringető szivattyú vezérlése: még okosabb fűtés
- Asszociációs játék. :)
- Nagy "hülyétkapokazapróktól" topik
- PLEX: multimédia az egész lakásban
- Fűzzük össze a szavakat :)
- CTEK akkumulátor töltő és másolatai
- Drive! - Az utolsó gurulás idén a Quadrifoglio-val
- Egy korszak vége
- Szólánc.
-
LOGOUT.hu
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.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
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á:
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- Indiana Jones and the Great Circle - Digital Premium Edition - beváltás: 2025.1.30 - RTX 40XX
- Game Pass Ultimate előfizetések 1 - 19 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- NORTON 360 for Mobile! 1 eszköz, 1 év! DOBOZOS, BONTATLAN!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest