macro automatisch starten

[benbiesterveld280]

Hallo allemaal,

Ik ben sinds vandaag lid en heb meteen een vraag.

Ik ben bezig met een personeels-planprogramma.
Nu zit ik met het volgende ik wil dat er bij het wijzigen van bepaalde cellen een macro wordt uitgevoerd.
Deze cellen zit in kolom A. En dan alleen de cellen in bepaalde rijen.
Zoals Cel A5, A9, A13, A17, A21 enz. Dus steeds vier rijen verder.
Om dit voor het hele werkblad te doen zou ik dus een If functie moeten gebruiken voor elke aparte regel. Gezien de grootte van het werkblad, wordt dat enorm.
Is er een mogelijkheid om dit te vereenvoudigen.

Alvast bedankt voor het meedenken.

P.S. ik gebruik Excel 2016.

Groetjes
Ben

 

[JanBG]

Welkom op dit forum, een voorbeeldje helpt echt

 

[benbiesterveld280]

?

ik kan geen bestand bijvoegen hoe doe ik dat, als ik op de paperclip druk doet hij niets.

 

[SjonR]

Dag Ben,

Probeer dit eens:

Private Sub Worksheet_Change(ByVal Target As Range)

For i = 5 To 21 Step 4
    If Target.Address = "$A$" & i Then
        
        '''''jouw code hier ''''''
     
    End If
Next
End Sub

21 even aanpassen naar wens uiteraard.

Op de paperclip drukken opent een scherm dat waarschijnlijk weer wegspringt. klik op je browsericoon in de taakbalk en dan zal je het wel zien denk ik.

 

[benbiesterveld280]

dan maar een voorbeeld

Bekijk bijlage planning.xlsx

 

[SjonR]

In je voorbeeld staat geen macro, dus daar wordt men niet veel wijzer van.

 

[benbiesterveld280]

top

ik ga dit proberen, zodra ik eruit ben horen jullie het van mij.

Voor zover bedankt voor jullie tijd en tips.

Ik ben een blije excel gebruiker hahahaha

 

[VenA]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count <> 1 Or Target.Column > 1 Or Target.Row < 5 Then Exit Sub
  If (Target.Row - 5) Mod 4 = 0 Then
    jouw code
  End If
End Sub

 

[benbiesterveld280]

dit gedeelte opgelost. nu nog een volgende kleine detail.

Heren toppie.


Voor de A kolom is dit opgelost, super.
Nu moet ik voor enkele andere kolommen hetzelfde hanteren, maar dan met andere intervallen. Moet ik dit dan gewoon herhalen of hoe kan ik dit in orde maken.

Nogmaals bedankt voor jullie adviezen.

 

[VenA]

Aan cryptogrammen hebben we hier niets. Klik even op de eerste regel in de handtekening van @SjonR

 

[benbiesterveld280]

Heren, bedankt voor jullie tips, ik heb alles al opgelost.

Toppie

 

[VenA]

Mogen we de oplossing ook weten? Is wel zo handig voor anderen die met een soortgelijke vraag zitten.

 

[benbiesterveld280]

formule maar even gekopieerd

Private Sub Worksheet_Change(ByVal Target As Range)


lts = Range("A65536").End(xlUp).Row
pr = ActiveCell.Address
C = ActiveCell.Column
R = Target.Row

For i = 9 To lts Step 5


If Target.Address = "$A$" & i Then GoTo tweede:
If Target.Address = "$D$" & i Then GoTo derde:
If Target.Address = "$F$" & i Then GoTo derde:
If Target.Address = "$H$" & i Then GoTo derde:
If Target.Address = "$J$" & i Then GoTo derde:
If Target.Address = "$L$" & i Then GoTo derde:
If Target.Address = "$N$" & i Then GoTo derde:
If Target.Address = "$P$" & i Then GoTo derde:
If Target.Address = "$R$" & i Then GoTo derde:
If Target.Address = "$T$" & i Then GoTo derde:
If Target.Address = "$V$" & i Then GoTo derde:
If Target.Address = "$X$" & i Then GoTo derde:
If Target.Address = "$Z$" & i Then GoTo derde:
If Target.Address = "$AB$" & i Then GoTo derde:
If Target.Address = "$AD$" & i Then GoTo derde:
If Target.Address = "$AF$" & i Then GoTo derde:
If Target.Address = "$AH$" & i Then GoTo derde:
If Target.Address = "$AJ$" & i Then GoTo derde:
If Target.Address = "$AL$" & i Then GoTo derde:
If Target.Address = "$AN$" & i Then GoTo derde:
If Target.Address = "$AP$" & i Then GoTo derde:
If Target.Address = "$AR$" & i Then GoTo derde:
If Target.Address = "$AT$" & i Then GoTo derde:
If Target.Address = "$AV$" & i Then GoTo derde:
If Target.Address = "$AX$" & i Then GoTo derde:
If Target.Address = "$AZ$" & i Then GoTo derde:
If Target.Address = "$BB$" & i Then GoTo derde:
If Target.Address = "$BD$" & i Then GoTo derde:
If Target.Address = "$BF$" & i Then GoTo derde:

Next
Exit Sub

tweede:
Range("B" & i).FormulaR1C1 = "=VLOOKUP(RC[-1],Objecten!C:C[7],7,FALSE)"

Range("C" & i).FormulaR1C1 = "=VLOOKUP(RC[-2],Objecten!C[-1]:C[6],8,FALSE)"
Range("A" & i + 1) = "=TEXT(R[-1]C[1],""u:mm"") & "" - "" & TEXT(R[-1]C[2],""u:mm"") & "" uur"""

GoTo Uitrekenen

derde:

Cells(R + 1, C).FormulaR1C1 = "=VLOOKUP(R[-1]C,Personeel!C2:C9,8,FALSE)"
Cells(R + 2, C).FormulaR1C1 = "=VLOOKUP(R[-2]C1,Objecten!C2:C9,7,FALSE)"
Cells(R + 2, C + 1).FormulaR1C1 = "=VLOOKUP(R[-2]C1,Objecten!C2:C9,8,FALSE)"
Cells(R + 4, C).FormulaR1C1 = "=((R[-2]C[1]+(R[-2]C[1]<R[-2]C))-R[-2]C)*24"
Cells(R + 3, C).FormulaR1C1 = "=IF(AND(R[-3]C<>""Lege Dienst"",R[1]C>0),"""",R[1]C)"
If Cells(R, C) = "Lege dienst" Then GoTo rood
If Cells(R, C) <> "Lege dienst" Then GoTo grijs

rood:
Cells(R, C).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
GoTo Uitrekenen

grijs:
Cells(R, C).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
.PatternTintAndShade = 0
End With
GoTo Uitrekenen

'uitrekenen totalen
Uitrekenen:
For R = 13 To lts Step 5
Range("BH" & R).FormulaR1C1 = "=SUM(RC[-56]:RC[-1])"
Range("BI" & R - 1).FormulaR1C1 = "=SUM(RC[-57]:RC[-2])"
Range("D2").FormulaR1C1 = "=SUM(C[56])"
Range("D3").FormulaR1C1 = "=SUM(C[57])"
Next
hc = ActiveCell

If Range("D3") > 0 Then GoTo rode
If Range("D3") >= 0 Then GoTo groene

rode:
Range("D3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range(pr).Select

Exit Sub

groene:
Range("D3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
.PatternTintAndShade = 0
End With

Range(pr).Select
Exit Sub


leeg:

End Sub

 

[benbiesterveld280]

korte uitleg

TargetAddress D tot en met Bf zijn de dagen in de periode.

 

[VenA]

Dank je. Nu nog even de code tussen codetags zodat het leesbaar is. Of het handig is om bij elke change het hele werkblad opnieuw op te bouwen laat ik maar in het midden. Als je een relevant voorbeeldje plaatst dan zal het vast gereduceerd worden tot een paar regels efficiënte code.

Nb. Goto is nogal uit de mode.