• 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.

Trage werking van macro?

Status
Niet open voor verdere reacties.
ZIPPO_2

ZIPPO_2

Gebruiker
Lid geworden
21 jun 2006
Berichten
88
Als ik gegevens in een tabel invul, worden de vakjes ingekleurd met onderstaande macro.Op zich werkt dit prima
Alleen mijn probleem is wanneer ik iets ingeef ik steeds even moet wachten alvorens ik het volgende gegeven kan ingeven, dus snelle invoer is niet mogelijk.
Kan er iemand mij vertellen hoe dit op te lossen is.Alvast bedankt

Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
ActiveSheet.Unprotect Password:="dat zou je willen weten"
Dim c As Range
For Each c In ActiveSheet.[H8:AL27]
With c
Select Case .Value
Case Is = "X", "KT", "ST"
.Font.ColorIndex = 10
.Interior.ColorIndex = 35
Case Is = "TL", "AF"
.Font.ColorIndex = 45
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 45
Case Is = "OA", "DS"
.Font.ColorIndex = 3
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 7
Case Is = "K", "O", "T"
.Font.ColorIndex = 55
.Interior.ColorIndex = 37
Case Is = "NA", "NB", "PR", "LG", "GW"
.Font.ColorIndex = 1
.Interior.ColorIndex = 40
Case Is = "PV"
.Font.ColorIndex = 52
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 53
Case Else
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End Select
End With
Next c
ActiveSheet.Protect Password:="dat zou je willen weten"
End Sub

[modedit] Codetags geplaatst en wachtwoord veranderd in iets onbruikbaars [/modedit]
 
Laatst bewerkt door een moderator:
tja, per wijziging worden er 620 cellen gecontroleerd als ik de macro goed lees.
Wacht maar tot iemand met meer verstand van VBA tips geeft om de macro aan te passen.

Richard
 
Waarom gebruik je niet target / activecell ipv je loop?
Nu loop je bij iedere wijziging alle cellen door ipv alleen de gewijzigde cel.

De al bstaande code kan je bewaren om op het einde alles nomaals te controleren :)

ps.
Graag de volgende keer je code tussen de code tags plaatsen. Wordt het een stuk overzichtelijker van. Bedankt.
 
Laatst bewerkt:
Volgens mij ontstaat er ook een soort kringverwijzing. Op het moment dat je iets aanpast zal de macro gestart worden. Hierdoor wordt de celopmaak van de betreffende cell gewijzigd, wat vervolgens ook weer tot gevolg heeft dat de macro (opnieuw) start. Pas wanneer je wacht totdat de gehele macro is doorlopen (zonder extra wijzigingen door te voeren), kun je je volgende invoer laten plaatsvinden. Dit is dus jouw wachten:D

Oplossing : schakel aan het begin van je macro de controle op wijzigingen uit
Code: 
Application.EnableEvents = False
en aan het eind van de macro weer aan
Code: 
Application.EnableEvents = True
. Hierdoor ontstaat de kringverwijzing niet meer.;)

Verder zou ik inderdaad alleen de gewijzigde cell kleuren, zodat niet steeds de gehele range doorlopen hoeft te worden. (zie opmerking Demeter) De code wordt dan:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect Password:="dat zou je willen weten"

With Target

Select Case .Value
Case Is = "X", "KT", "ST"
.Font.ColorIndex = 10
.Interior.ColorIndex = 35
Case Is = "TL", "AF"
.Font.ColorIndex = 45
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 45
Case Is = "OA", "DS"
.Font.ColorIndex = 3
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 7
Case Is = "K", "O", "T"
.Font.ColorIndex = 55
.Interior.ColorIndex = 37
Case Is = "NA", "NB", "PR", "LG", "GW"
.Font.ColorIndex = 1
.Interior.ColorIndex = 40
Case Is = "PV"
.Font.ColorIndex = 52
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 53
Case Else
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End Select

End With
ActiveSheet.Protect Password:="dat zou je willen weten"
End Sub
Hoop dat dit de oplossing voor je is.



Apikills
 
Laatst bewerkt door een moderator:
apikills zei:
Volgens mij ontstaat er ook een soort kringverwijzing. Op het moment dat je iets aanpast zal de macro gestart worden. Hierdoor wordt de celopmaak van de betreffende cell gewijzigd, wat vervolgens ook weer tot gevolg heeft dat de macro (opnieuw) start. Pas wanneer je wacht totdat de gehele macro is doorlopen (zonder extra wijzigingen door te voeren), kun je je volgende invoer laten plaatsvinden. Dit is dus jouw wachten
Klik om te vergroten...

Klopt niet. Het toepassen van een kleurtje heeft niet tot gevolg dat de macro uitgevoerd wordt. Het toepassen van een kleurtje is trouwens geen Gebeurtenis die je kan traceren in VBA. Best we lastig, maar het is zo.

Wigi
 
Zippo, een paswoord zet je normaal gezien niet op een forum... tenzij dat iedereen het mag weten van jou.

Wigi
 
Wigi zei:
Klopt niet. Het toepassen van een kleurtje heeft niet tot gevolg dat de macro uitgevoerd wordt. Het toepassen van een kleurtje is trouwens geen Gebeurtenis die je kan traceren in VBA. Best we lastig, maar het is zo.

Wigi
Klik om te vergroten...

Moet Wigi inderdaad hierin gelijk geven:o

apikills
 
Allereerst mijn excuses voor de de begane stommiteiten.
Ik zal er de volgende keer zeker op letten
Nu wat beterft de macro ik heb de veranderingen aangebracht maar het werkt niet
Als ik de codes invul kleuren ze maar als ik ze nadien delete blijven de kleuren achter op het blad en als ik dan terug een code ingeef doet hij niks meer.
 
Voordat je je file upload zou ik eerst:
Je wachtwoord verwijderen uit je eerste post
De code toch eventjes tussen de code tags plaatsen.

Thanks.
 
Ik zie het probleem niet. Bij mij gaat het wel: cel deleten en terug invullen.

Wigi
 
Vanaf dat ik het veranderd heb werkt het niet meer en nu ik de oude code teruggezet heb doet hij het helemaal niet meer:(
 
Bedankt voor het aanpassen.
Zou het misschien kunnen zijn dat het ligt aan het feit dat ik de macro aan 10 werkbladen van mijn werkmap heb gelinkt(Totale werkmap bevat 24 bladen) en dat ik misschien beter 1 macro voor de 10 bladen gebruik? Zo ja hoe los ik dat op.
 
Doe dit:

Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     Updaten
End Sub

Kopieer dit in elk blad waar het nodig is.

Vervolgens doe je Invoegen > Module en maak je de procedure

Code: 
Sub Updaten()

Daarin zet je de code die je nu gebruikt.

Als er geen of weinig andere bladen zijn in het bestand dan die waar de kleuren moeten komen, is het interessanter de Change gebeurtenis voor het hele bestand eenmalig te zetten. Zie bij ThisWorkbook en werk analoog. Dan kunnen de Worksheet_Change codes achter elk blad weg.

Wigi
 
Laatst bewerkt:
Ik heb gedaan zoals gevraagd en het werkt ..... maar alleen met de macro die ik eerst had. Als ik de macro van apikills gebruik krijg ik telkens fout 424 bij uitvoering

Code: 
Sub Updaten()

With Target
[COLOR="yellow"][B]Select Case .Value[/B][/COLOR]
Case Is = "X", "KT", "ST"
.Font.ColorIndex = 10
.Interior.ColorIndex = 35
Case Is = "TL", "AF"
.Font.ColorIndex = 45
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 45
Case Is = "OA", "DS"
.Font.ColorIndex = 3
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 7
Case Is = "K", "O", "T"
.Font.ColorIndex = 55
.Interior.ColorIndex = 37
Case Is = "NA", "NB", "PR", "LG", "GW"
.Font.ColorIndex = 1
.Interior.ColorIndex = 40
Case Is = "PV"
.Font.ColorIndex = 52
.Interior.Pattern = xlLightUp
.Interior.PatternColorIndex = 53
Case Else
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End Select
End With


End Sub
 
Ik heb nu
Code: 
Application.EnableEvents = False



Application.EnableEvents = True
erbij gezet en nu werkt het bijna
......want de vakjes worden niet ingekleurd
 
Laatst bewerkt:
En als je deze achter je blad plakt:
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     Updaten(Target)
End Sub

Nu geef je je var. Target door naar de macro updaten.
 
Zie dat Target niet werkt.

Code: 
Sub Updaten([COLOR="Red"]Targetadres As String[/COLOR])

With Range(Targetadres)
    Select Case .Value
        Case Is = "X", "KT", "ST"
            .Font.ColorIndex = 10
            .Interior.ColorIndex = 35
        Case Is = "TL", "AF"
            .Font.ColorIndex = 45
            .Interior.Pattern = xlLightUp
            .Interior.PatternColorIndex = 45
        Case Is = "OA", "DS"
            .Font.ColorIndex = 3
            .Interior.Pattern = xlLightUp
            .Interior.PatternColorIndex = 7
        Case Is = "K", "O", "T"
            .Font.ColorIndex = 55
            .Interior.ColorIndex = 37
        Case Is = "NA", "NB", "PR", "LG", "GW"
            .Font.ColorIndex = 1
            .Interior.ColorIndex = 40
        Case Is = "PV"
            .Font.ColorIndex = 52
            .Interior.Pattern = xlLightUp
            .Interior.PatternColorIndex = 53
        Case Else
            .Font.ColorIndex = 1
            .Interior.ColorIndex = xlNone
    End Select
End With

End Sub

en achter je blad:
Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Targetadres = Target.Address
    Updaten ([COLOR="red"]Targetadres[/COLOR])
End Sub

Werkt bij mij wel.

ps.
Let op de rode gedeelten, das de manier om een variabele mee te nemen in een andere macro.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan