• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Code van Case aanpassen

Status
Niet open voor verdere reacties.
R

rob91

Gebruiker
Lid geworden
10 okt 2008
Berichten
198
Hallo
Kan iemand mij vertellen hoe ik een range aan kan geven in mijn code met Case.
De bedoeling is dat als de waarde tussen 0,25 en 10 ligt dat deze cel kleur 45 krijgt.
Nu was ik al bezig op alle afzonderlijke waarden erin te zetten maar dat moet toch netter/korter kunnen.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
Target = UCase(Target)
Range("J46").Value = Date
Range("J49").Value = Application.UserName
With Target.Interior
.ColorIndex = 2
Select Case UCase(.Parent.Value)
Case "Z", "ZM"
.ColorIndex = 3
Case "ZV"
.ColorIndex = 22
Case "0,25", "0,5", "0,75", "1,00", "1,25", "1,5", "1,75", "2,0", "2,25", "4,5"
.ColorIndex = 45
End Select
End With
End If

Rob
 
Aangezien de waarde tussen 0,25 en 10 moet liggen kan je ...
Code: 
Case "0,25", "0,5", "0,75", "1,00", "1,25", "1,5", "1,75", "2,0", "2,25", "4,5"
... vervangen door ...

Code: 
Case Is > 0.25, Is < 10

Met vriendelijke groet,


Roncancio
 
Hallo Roncancio,

bedankt voor je antwoord; echter er gebeurt nog niets als ik een waarde in de cel zet.
Wat kan het probleem nog zijn ?

Rob

Case Is >= 0.25, Is <= 10
.ColorIndex = 45
 
Dat komt omdat je Enable.Events op False hebt gezet zonder deze weer erna True hebt gezet.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
Target = UCase(Target)
Range("J46").Value = Date
Range("J49").Value = Application.UserName
With Target.Interior
.ColorIndex = 2
Select Case UCase(.Parent.Value)
Case "Z", "ZM"
.ColorIndex = 3
Case "ZV"
.ColorIndex = 22
Case Is > 0.25, Is < 10 
.ColorIndex = 45
End Select
End With
End If
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Met vriendelijke groet,


Roncancio
 
Wellicht ook iets leesbaarder:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
    Range("J46").Value = Date
    Range("J49").Value = Application.UserName

   Select Case UCase(Target)
   Case "Z", "ZM"
     Target.interior.ColorIndex = 3
   Case "ZV"
     Target.interior.ColorIndex = 22
   case else
     if val(target)>0 then Target.Interior.ColorIndex = iif(4*target=>1 and 4*target=<40, 45,2)
   End select
  End If
End Sub
 
Laatst bewerkt:
Hallo Roncancio,

Helaas is je antwoord niet correct, maar dan kon je niet weten omdat ik niet de gehele code als bijlage gegeven had. (Ik dacht dat dit niet relevant voor mijn vraag was; sorry)
De volledige code is:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
Target = UCase(Target)
Range("J46").Value = Date
Range("J49").Value = Application.UserName
With Target.Interior
.ColorIndex = 2
Select Case UCase(.Parent.Value)
Case "Z", "ZM"
.ColorIndex = 3
Case "ZV"
.ColorIndex = 22
Case Is >= 0.25, Is <= 10
.ColorIndex = 45
End Select
End With
End If
Range("AK40:AK41").ClearContents
For Each c In Range("F26:AJ37")
If c.Interior.Color = vbRed And c.Value = "ZM" Then
Range("AK41").Value = Range("AK41").Value + 1
ElseIf c.Interior.Color = vbRed And c.Value = "Z" Then
Range("AK40").Value = Range("AK40").Value + 1
End If
Next c
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Zie je toch nog mogelijkheden ?

Rob
 
@SNB
Als je de Case Else gebruikt voor de de waardes tussen 0,25 en 10 moet je er wel zeker van zijn dat er geen andere tekst ingevoerd kunnen worden.
M.a.w. als bijv. AB wordt ingevoerd krijg je een foutmelding.

M.i. kan je beter een Case gebruiken voor bovenstaande en een Case Else voor een willekeurige invoer.

Oh ja, er moest nog een End...Sub aan het eind bij.

Met vriendelijke groet,


Roncancio
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
    Range("J46").Value = Date
    Range("J49").Value = Application.UserName
    With Target.Interior
        .ColorIndex = 2
        Select Case UCase(Target.Value)
        Case "Z", "ZM"
            .ColorIndex = 3
        Case "ZV"
            .ColorIndex = 22
        Case 0.25 To 10
            .ColorIndex = 45
        End Select
    End With
    Range("AK40:AK41").ClearContents
    Range("AK41").Value = WorksheetFunction.CountIf(Range("F26:AJ37"), "ZM")
    Range("AK40").Value = WorksheetFunction.CountIf(Range("F26:AJ37"), "Z")
End If

End Sub

Met vriendelijke groet,


Roncancio
 
Jammer,.............

Maar ik krijg de kleurweergave 45 bij een celwaarde niet aan de praat
de celwaarde Z en ZM doen het wel geod, maar bij invullen van een waarde tussen 0,25 en 10 doet het niets.

Nu heb ik het via voorwwardelijke opmaak geregeld maar dat werkt somst ook niet, vandaar dat ik het op mijn manier op wilde lossen.

Ik heb te weinig verstand van code om zien waarom het niet werkt.

Rob
 
rob91 zei:
Jammer,.............

Maar ik krijg de kleurweergave 45 bij een celwaarde niet aan de praat
de celwaarde Z en ZM doen het wel geod, maar bij invullen van een waarde tussen 0,25 en 10 doet het niets.

Nu heb ik het via voorwwardelijke opmaak geregeld maar dat werkt somst ook niet, vandaar dat ik het op mijn manier op wilde lossen.

Ik heb te weinig verstand van code om zien waarom het niet werkt.

Rob
Klik om te vergroten...
De code werkt bij mij wel.
Wellicht ten overvloede, maar de code gaat uit van waardes geen tekst.

Met vriendelijke groet,


Roncancio
 
Ik heb even een nieuwe test gedaan en nu komt inderdaad de kleur, maar deze verdwijnt nu niet als ik de waarde uit de cel weghaal.!?????:eek:

Rob
 
rob91 zei:
Ik heb even een nieuwe test gedaan en nu komt inderdaad de kleur, maar deze verdwijnt nu niet als ik de waarde uit de cel weghaal.!?????:eek:

Rob
Klik om te vergroten...

Ook dát gaat bij mij goed.
Als ik op Del klikt, verdwijnt de waarde en dmv de macro verdwijnt ook de kleur.

Met vriendelijke groet,


Roncancio
 
Ik ben er intussen achter dat het probleem ontstaat door de code van het tellen van de cellen met ZM en Z.
Als ik deze code uitschakel gaat het goed met de kleur bij een waarde tussen 0,25 en 10.
Ok verdwijnt deze dan weer bij verwijderen van de waarde

Zowel mijn oude code als de nieuwe code voor het tellen van de cellen ZM en Z werkt nu niet goed. Zodra ik een cel vul met ZM komt er geen aantal meer .:eek:
 
rob91 zei:
Ik ben er intussen achter dat het probleem ontstaat door de code van het tellen van de cellen met ZM en Z.
Als ik deze code uitschakel gaat het goed met de kleur bij een waarde tussen 0,25 en 10.
Ok verdwijnt deze dan weer bij verwijderen van de waarde

Zowel mijn oude code als de nieuwe code voor het tellen van de cellen ZM en Z werkt nu niet goed. Zodra ik een cel vul met ZM komt er geen aantal meer .:eek:
Klik om te vergroten...

Welke handelingen voer je precies uit want als ik Z en ZM toevoeg aan het bereik dan worden de aantallen Z en ZM opgeteld.
Het kan zijn dat er verwijzingen in het bereik ervoor zorgen dat het resultaat anders is dan gewenst.

Met vriendelijke groet,


Roncancio
 
Ik ben eruit........::)

Ik voerde de code ZM en Z via een knop met makro in en daarin zat nog weer een stukje code wat ervoor zorgde dat alles weer gewist werd.

Mijn probleem is opgelost; bedankt voor alle hulp.:thumb:

Rob
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan