Kleur toekennen aan een cel dmv een tabel

[ZIPPO_2]

Op een werkblad heb ik een referentiegetal en 3 uitkomsten
Nu is het de bedoeling dat de 3 uitkomsten aan de hand van een tabel op een volgend blad de overeenstemmende kleur krijgen.
Ik heb op het forum wel de tip van luc hendrickx ivm voorwaardelijke opmaak via VBA gevonden maar na uren van puzzelen en proberen ben ik er niet uitgekomen
Bijgevoegd voorbeeldje maakt het mss nog iets duidelijker

 

[dirktimm]

Kleur toekennen aan een cel dmv tabel

Hallo Zippo,

Bijgaand een bijgewerkt bestand. Er zullen ongetwijfeld mensen (Wigi) zijn die de VBA code veel korter kunnen schrijven. Ik ben ook benieuwd naar deze kortere code. Maar deze oplossing werkt ook.

Groet

Dirk

 

[ZIPPO_2]

Hoi Dirk
Het werkt fantastisch. Bedankt
Ik ook ben benieuwd of er een kortere versie mogelijk is.
Wss wel
Ik heb nog een bijkomend vraagje
Welke regel(s) moet ik toevoegen aan de macro wanneer deze bewerking op meerdere werkbladen moet uitgevoerd worden.
Als ik het blad kopieer dan is het geen probleem maar dan zit ik 20 keer met dezelfde macro (20 bladen) en dan vrees ik dat dat een beetje de uitvoeringssnelheid van mijn werkmap benadeeld
Groetjes Ronny

 

[Wigi]

Ik heb mijn naam horen vallen... Ik doe mijn best, wie weet komt er wel iets uit

 

[ZIPPO_2]

Neem je tijd maar Wigi er is geen haast bij
Nog een vraagje over de macro van Dirk.Ik heb hem ontleed en begrijp hem ook alleen de range E8:I11 snap ik niet of is dat een typefoutje en moet het E8:I8 zijn?
Groeten
Ronny

 

[dirktimm]

Kleur toekennen

Hallo Zippo,

Om met de laatste opmerking te beginnen. Klopt I11 moet zijn I8. Is een (type) foutje.
Als je op meerdere tabbladen deze code wilt laten werken, dan moet je de VBA code opslaan in ThisWorkbook. De code werkt dan op elk tabblad op basis van de zelfde criteria dus E8 : I8 enz.

Groet,

Dirk

 

[ZIPPO_2]

kleur toekennen

Ik had al zo een vermoeden en had dat laatste had ik ondertussen al uitgeprobeerd en het werkte :thumb:
groetjes
Ronny

 

[Wigi]

Zippo

Hier is al wat minder code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, gevonden As Range
If Target.Address = "$E$3" Then
    On Error Resume Next
    Set gevonden = Sheets("tabel2").Range("B3:B27").Find(what:=Target, lookat:=xlWhole)
    If Err.Number <> 0 Then
        Exit Sub
    Else
        For Each rng In Range("E8,G8,I8")
            With rng.Interior
                Select Case rng.Value
                    Case Is < gevonden.Offset(, 1)
                        .ColorIndex = xlNone
                    Case Is < gevonden.Offset(, 2)
                        .ColorIndex = gevonden.Offset(, 1)
                    Case Is < gevonden.Offset(, 3)
                        .ColorIndex = gevonden.Offset(, 2)
                    Case Is < gevonden.Offset(, 4)
                        .ColorIndex = gevonden.Offset(, 3)
                    Case Else
                        .ColorIndex = gevonden.Offset(, 4)
                End Select
            End With
        Next
    End If
End If
End Sub

Test het en laat het ons weten.

Ben nog bezig met de Select Case om te zetten naar een CountIf, maar dat wil maar niet lukken :evil:

Wigi

 

[Wigi]

Hier is de kortere versie waarop ik zat te broeden...

Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, FoundCell As Range, kleiner As Integer
If Target.Address = "$E$3" Then
    On Error Resume Next
    Set FoundCell = Sheets("tabel2").Range("B3:B27").Find(what:=Target, lookat:=xlWhole)
    If Err.Number <> 0 Then
        Exit Sub
    Else
        For Each rng In Range("E8,G8,I8")
            If WorksheetFunction.CountIf(FoundCell.Offset(, 1).Resize(, 4), "<=" & Replace(rng.Value, ",", ".")) = 0 Then
                rng.Interior.ColorIndex = xlNone
            Else
                rng.Interior.ColorIndex = FoundCell.Offset(, WorksheetFunction.CountIf(FoundCell.Offset(, 1).Resize(, 4), "<=" & _
                Replace(rng.Value, ",", "."))).Interior.ColorIndex
            End If
        Next
    End If
End If
End Sub

Wigi

 

[ZIPPO_2]

Kleur toekennen

ik heb de laatste macro ingevoerd maar hij schijnt het niet te doen
Greetz Zippo

 

[Wigi]

ik heb de laatste macro ingevoerd maar hij schijnt het niet te doen
Greetz Zippo

Ingevoegd in een bestandje dat hier al in je vraag stond?

 

[ZIPPO_2]

ja inderdaad

 

[Wigi]

Ik vermoed dat de code niet op de juiste plaats staat, want zowel voor het bestand in de vraag als voor dat in het eerste antwoord, werkt het.

 

[Wigi]

ja inderdaad

Waar zet je de code neer?

 

[ZIPPO_2]

ik heb hem achtereenvolgens in this workbook gezet, toen dat niet werkte in blad 1 en toen dat ook niet werkte in module1
Ronny

 

[Wigi]

ik heb hem achtereenvolgens in this workbook gezet, toen dat niet werkte in blad 1 en toen dat ook niet werkte in module1
Ronny

Code moet komen achter het blad met de cel E3 die verandert.

Als je dat gedaan hebt run je voor de zekerheid 1 keer dit:

Sub ee()
Application.EnableEvents = True
End Sub

Dit kan je gewoon onder de andere macro zetten. Voer het 1 keer uit en delete het daarna. Dan zou de eerste macro moeten werken.

Opdat de eerste macro zou werken verander je E3. Lukt het nu?

Wigi

 

[Wigi]

OK. Ik heb het zelf gedaan en je eerste bestandje - aangevuld - nog eens bijgehangen.

Wigi

 

[ZIPPO_2]

het werkt maar......(sorry hoor) niet zoals het hoort
telkens ik gegevens ingeef om een uitkomst te berekenen moet ik het referentie getal opnieuw ingeven of veranderen om de macro te doen werken terwijl het referentiegetal nadat het is berekend een vaste waarde is. ik hoop dat ik een beetje duidelijk ben
Groetjes
Zippo

 

[Wigi]

het werkt maar......(sorry hoor) niet zoals het hoort
telkens ik gegevens ingeef om een uitkomst te berekenen moet ik het referentie getal opnieuw ingeven of veranderen om de macro te doen werken terwijl het referentiegetal nadat het is berekend een vaste waarde is. ik hoop dat ik een beetje duidelijk ben
Groetjes
Zippo

Niet echt helemaal nee...

Wanneer moeten de 3 cellen gekleurd worden?

 

[ZIPPO_2]

Wigi anders moet je even het bestadje van dirktimm even openen.Als je dan de gegevns x en y verandert (de lichtgrijze getallen)dan zie je wat er gebeurt of wat de bedoeling is
Ronny