Betinget formatering

Du skal bruge formlen PLADS()

f.eks hvis du har tallene i A2 til D2
Så er formlen i A1  =PLADS(A2;$A$2:$D$2;0)

Jeg kan godt se, at formlen returnerer den rigtige placering, men jeg er ude efter, at få den betingede formatering rigtig.

Således at;
1. pladsen er gul
2. pladsen er rød
3. pladsen er grøn
4. pladsen er sort

tak

4 Farver så er det vba.
Sender en kode når jeg kommer hjem til en computer.

Lyder godt! I mellemtiden har jeg lige fået et andet problem.

Jeg har tal i felterne A1;C1;E1;G1

I felterne B1 skal jeg lave formlen Plads(B1;A1:G1;0), men så får jeg cirkulær reference.

Hvordan laver jeg referencen om, så den springer de felter over, hvor jeg skal skrive formlen...?

Tak

Formel i celle B1 skal være: =PLADS.LIGE(A1;($A$1;$C$1;$E$1;$G$1);0)

VBA: Højreklik på arkfanen - vis programkode -
Indsæt koden: farver opdateres når værdierne i celle A1 C1 E1 eller G1 ændres.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:H1"), Target) Is Nothing Then
With Target
    Select Case Target.Value
        Case 1
        .Interior.ColorIndex = 6
        .Font.ColorIndex = 6
        Case 2
        .Interior.ColorIndex = 3
        .Font.ColorIndex = 3
        Case 3
        .Interior.ColorIndex = 4
        .Font.ColorIndex = 4
        Case 4
        .Interior.ColorIndex = 1
        .Font.ColorIndex = 1
      Case Else
        .Interior.ColorIndex = xlNone
    End Select
End With
End If
End Sub

Var lidt for hurtig, den skal lige finpudses.

Formel
B2: =PLADS.LIGE(A1;(A1;C1;E1;G1);0)
D1: =PLADS.LIGE(C1;(A1;C1;E1;G1);0) osv

Så Nu fungerer det
Cellerne med de indtastede værdier farves.
celle B1: =PLADS(A1;(A1;C1;E1;G1);0) osv.
.....................

Indsæt denne i et Modul i VBA

Function FarvRækker()

Application.ScreenUpdating = False
Dim C As Range
'marker celle A1:H1
Range("A1:H1").Select
For Each C In Selection.Cells
'hvor celle indeholder et l farves cellen til venstre gul.
      If C.Value = 1 Then
        'farv cellen i kolonne I med farve 3
        C.Offset(0, -1).Interior.ColorIndex = 6
        C.Offset(0, -1).Font.ColorIndex = 1
      ElseIf C.Value = 2 Then
'hvor celle indeholder et 2 farves cellen til venstre rød.
        C.Offset(0, -1).Interior.ColorIndex = 3
        C.Offset(0, -1).Font.ColorIndex = 1
      ElseIf C.Value = 3 Then
'hvor celle indeholder et 3 farves cellen til venstre grøn.
        C.Offset(0, -1).Interior.ColorIndex = 4
        C.Offset(0, -1).Font.ColorIndex = 1
      ElseIf C.Value = 4 Then
'hvor celle indeholder et 4 farves cellen til venstre sort og tallet hvid.
        C.Offset(0, -1).Interior.ColorIndex = 1
        C.Offset(0, -1).Font.ColorIndex = 2
     
    End If
Next
Range("A6").Select

'Application.EnableEvents = True
Application.ScreenUpdating = True

End Function

...........................

Indsæt denne i kode vindue for det ark hvor du har tallene

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("A1:H1"), Target) Is Nothing Then
Call FarvRækker
End If
End Sub

.............................

Sweet! Tak!

Du må gerne sende arket. Kan du uploade på www.gratisupload.dk ?

Og tryk bare svar, hvis du vil have point :)

Svar