Avatar billede Butterfly Ekspert
27. januar 2022 - 16:49 Der er 4 kommentarer og
2 løsninger

Betinget formatering hvis celle aktiv

Hej
Hvis jeg står i celle B1 (cellen er aktiv) er det så muligt at lave noget betinget formatering eller VBA, så celle B2 og B3 bliver farvet gule?
27. januar 2022 - 17:08 #1
Det kan gøres på flere måder, her er en af dem... koden skal ligge bagved arket - højreklik på fanen og vælg "vis kode"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        Range("B2").Interior.Color = vbYellow
        Range("B3").Interior.Color = vbYellow
    Else
        Range("B2").Interior.Color = xlNone
        Range("B3").Interior.Color = xlNone
    End If
End Sub
Avatar billede Butterfly Ekspert
27. januar 2022 - 17:17 #2
Mange tak Flemming Vadet, det virker perfekt, men nu bliver jeg meget krævende :-)
Jeg vil gerne have at når jeg står i B1 så farves B2 og B3 (det virker), når jeg står i E1 så farves E2 og E3, når jeg står i F1 så farves F2 og F3
27. januar 2022 - 17:28 #3
Kun de 3 kolonner eller gælder det altid når du markerer en celle i række 1 ?
Avatar billede Butterfly Ekspert
27. januar 2022 - 17:30 #4
Jeg løste det ved at sætte dem ind efter hinanden, det virker :-)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Unprotect
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        Range("B2").Interior.Color = vbYellow
        Range("B3").Interior.Color = vbYellow
    Else
        Range("B2").Interior.Color = xlNone
      Range("B3").Interior.Color = xlNone
    End If
        If Not Intersect(Target, Range("E1")) Is Nothing Then
        Range("E2").Interior.Color = vbYellow
    Else
        Range("E2").Interior.Color = xlNone
        Range("E3").Interior.Color = xlNone
    End If
        If Not Intersect(Target, Range("F1")) Is Nothing Then
        Range("F2").Interior.Color = vbYellow
        Range("F3").Interior.Color = vbYellow
    Else
        Range("F2").Interior.Color = xlNone
        Range("F2").Interior.Color = xlNone
    End If
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
End Sub
27. januar 2022 - 17:48 #5
Og den kort version, hvor du nemt kan tilføje en celle i Union'en...

Public rCurCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rReactOn As Range
   
    If rCurCell Is Nothing Then Set rCurCell = Target
    Set rReactOn = Union(Range("B1"), Range("E1"), Range("F1"))
    If Not Intersect(rCurCell, rReactOn) Is Nothing Then
        rCurCell.Offset(1, 0).Interior.Color = xlNone
        rCurCell.Offset(2, 0).Interior.Color = xlNone
    End If
   
    If Not Intersect(Target, rReactOn) Is Nothing Then
        Target.Offset(1, 0).Interior.Color = vbYellow
        Target.Offset(2, 0).Interior.Color = vbYellow
    End If
    Set rCurCell = Target
End Sub
Avatar billede Butterfly Ekspert
01. februar 2022 - 16:02 #6
Mange tak Flemming den er mere elegant
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





CIO
Årets CIO 2022: Nu skal Danmarks dygtigste CIO findes - er det dig? Eller kender du en, du vil indstille?