Værdi indenfor grænser medfører farve i celle

Du skal bruge Formater - Betinget formatering, her kan du angive værdier og farver.

Hej - i arkets eget kodemodul kan du placere denne makro - rediger selv det / de range(s) der skal benyttes

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rConFormat As Range
    Set rConFormat = Range("A1:B10", "D11:E20")
   
    If Not Intersect(Target, rConFormat) Is Nothing Then
        With Target
            If IsNumeric(.Value) Then
                Select Case UCase(.Value)
                    Case 2
                        .Interior.ColorIndex = 3
                    Case 5
                        .Interior.ColorIndex = 8
                    ' Her kan være flere Case linier
                    ' stil markøren i ColorIndex og tryk F1
                    ' for hjælp til farvenumre
                   
                    Case Else
                        .Interior.ColorIndex = xlColorIndexNone
                End Select
            End If
        End With
    End If
End Sub

tida >> betinget formatering kan kun håndtere 3 argumenter

Hej Flemming!

Jeg føler mig overbevist om at du har en god løsning, men...

Kodemodul? Når jeg højreklikker på arkfanen kan jeg åbne "Vis programkode" Er det dér jeg skal indsætte makroen?

Jeg kan får alt efter hvor jeg foretager input den pågældende værdi i en af 4 celler, H21, H22, H23 eller H25. Er det disse celler, som er "case 2" osv.

Den beregnede værdi skal vægtes i forhold til 4 intervaller, f.eks. 1,0 - 1,99.
Ligger værdien indenfor et af disse intervaller, skal selve cellen med værdien skifte baggrundsfarve samtidig med, at værdien selvfølgelig skal kunne læses.

Colorindex? I en dansk version vel farveindex? Hvor findes den?

Ak ja, ikke så let at hjælpe nogen som er flere niveauer under een selv.

Hilsen KOL

Ja - sorry... højreklik på arkfanen og vælg "Vis programkode..."

Det kunne f.eks. se således ud:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rConFormat As Range
    Set rConFormat = Range("H21:H25")
   
    If Not Intersect(Target, rConFormat) Is Nothing Then
        With Target
            If IsNumeric(.Value) Then
                Select Case UCase(.Value)
                    Case Is < 1.99
                        .Interior.ColorIndex = 3
                    Case Is < 2.99
                        .Interior.ColorIndex = 8
                    Case Is < 3.99
                        .Interior.ColorIndex = 15
                    Case Is < 4.99
                        .Interior.ColorIndex = 23
                    Case Else
                        .Interior.ColorIndex = xlColorIndexNone
                End Select
            End If
        End With
    End If
End Sub

Se ColorIndex her (engelsk og kun i VBA)
http://www.win-consult.com/Tips/LibrarySource.asp?App=Excel&Lib=ColorRows

Hej igen,

Jeg har kopieret din makro, fra Private Sub...  til End sub ind som beskrevet, men... der sker ikke videre. Skal den aktiveres på nogen speciel måde?

Jeg har set på din hjemmeside, men de farver, jeg har valgt er standard pastelfarver fra Excel's egen palette m. fyldfarver, konkret er det i nederste række fra venstre: Nr. 2, 3, 4 og 9.

De der Cases: I første eksempel skrev du "Case 2" osv. men nu er der ikke nummer på mere. Hvordan undgås det så, hvis værdien er < 4,99, at makroen vil forsøge at indsætte alle 4 farver på een gang? Alle cases er jo < 4,99.

Til videre ikke noget problem, da jeg slet ikke har fundet ud af, hvordan makroen aktiveres.

Hilsen KOL

Makro'en bliver aktiveret, hvis du ændre i en celle i området H21:H25

Men ved nærmere eftertanke, så er det nok ikke i de celler ud ændre noget... der har du vel formler...

Du kan sende mig arket, så skal jeg tilpasse den - klik på mit navn for email-adresse

Det er nok det enkleste.
Er sendt.

KOL

har først lige fået den nu!! ikke din fejl.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rCell As Range
    Dim rConFormat As Range
    Set rConFormat = Range("H21:H25")
   
    If Not Intersect(Target, Range("F21:F25")) Is Nothing Then
        For Each rCell In rConFormat
            With rCell
                Select Case UCase(.Value)
                    Case Is < 1
                        .Interior.ColorIndex = 40
                    Case Is < 2
                        .Interior.ColorIndex = 35
                    Case Is < 3
                        .Interior.ColorIndex = 39
                    Case Is < 4
                        .Interior.ColorIndex = 36
'                    Case Is < 5    ' Ikke aktuel
'                        .Interior.ColorIndex = 36
                    Case Else
                        .Interior.ColorIndex = xlColorIndexNone
                End Select
            End With
        Next rCell
    End If
End Sub

Flemming, du er bare super!
Tak for hjælpen, men er sølle 30 point nok?

tida  Også tak til dig for din indsats. Det var jo ikke helt ved siden af.

Hilsen KOL

jaja - 30 er fint :-) det er jo ikke dem der betaler rødvinen *gg*