in verschillende cellen een ingevoerde waarde zetten voor een planner

[adkliko]

Hallo allemaal.

Ik loop vast op een script dat ik bij elkaar verzameld heb maar wat wel werkt.
Echter werkt het alleen maar op 1 cel en wel op cel A1.
Ik ben nog helemaal onbekend met VBA dus ik hoop dat jullie me weer een zetje de goed kan op kunnen geven.
Het scriptje is voor een capaciteits planning die ik aan het maken ben.
Echter ontbreekt nog de TVT (Tijd Voor Tijd) registratie.

beschrijving script:
Als je in cel A1 tvt in typed dan komt er een inputbox op.
In de inputbox vul je een waarde in bv 2
De waarde 2 wordt nu in cel A10 gezet.
Hier kan ik dan mee gaan rekenen.
echter kan dit maar voor 1 cel.

Hoe kan ik dit script copieren zodat ik 365 cellen (dagen in het jaar) kan aansturen.
Of moet dit heel anders gebeuren. zoja hoe?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Target.Address(0, 0) = "A1" Then

    Select Case LCase(Target.Value)
        Case "tvt": Call tvturen
        Case Else: MsgBox "Do not Delete"
    End Select
End If
Application.EnableEvents = True
End Sub

Sub Numeric_tvturen()

If Range("A1").Value = "tvt" Then
    tvtsub
    End If
   End Sub
Sub tvtsub()

UserValue = InputBox("TVT uren")
Range("A10").Value = UserValue

End Sub

 

[WinteE]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

For Each c in Target

    Select Case LCase(Target.Value)
        Case "tvt": Call tvturen
        Case Else: MsgBox "Do not Delete"
    End Select
Next c

Application.EnableEvents = True

End Sub

Sub Numeric_tvturen()

If Range("A1").Value = "tvt" Then
    tvtsub
    End If
   End Sub
Sub tvtsub()

UserValue = InputBox("TVT uren")
Range("A10").Value = UserValue

End Sub

Met een For .. Each lus kan je een geselecteerd bereik doorlopen. Dus je selecteert A1:F1 en start de macro.

 

[adkliko]

Beste WinteE

Ik krijg het niet voor elkaar. hij blijft in een lus draaien.
Kan iemand misschien de code die uit drie delen bestaat terug brengen naar 1 deel.

groetjes marcel

 

[Warme bakkertje]

Post eens een voorbeeldbestandje zodat we de opbouw van je werkblad kunnen bekijken en een gericht antwoord op je vraag geven. Je stelt dat A1 overeenkomt met A10, maar hoe zit het de de 364 andere dagen ?

 

[adkliko]

Ik heb de code ondertussen iets vereenvoudigt.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Range("J4").Value = "" Then MsgBox "do not delete"
If Range("J4").Value = "tvt" Then
   UserValue = InputBox("TVT uren")
Range("J107").Value = UserValue
   
End If

Application.EnableEvents = True
End Sub

Ik heb deze code in mijn planner gezet voor veld J4 of te wel 4 januari
Ik zal het bestand vanavond er bij zetten. Dit gaat helaas niet vanaf de zaak
De bovenstaande opdracht werkt zoals ik al heb gezegt. alleen werkt deze maar alleen op 1 cel.
Ik heb een script nodig wat bovenstaande doet maar dan voor alle dagen in het jaar...dus 365 stuks dus ook 365 cellen

 

[adkliko]

bij deze de bijlage.
Ik heb echter een aantal tabbladen moeten weg halen en een deel van het jaar.

gr marcel

 

[Warme bakkertje]

Is de rij met tvt steeds rij 4 en is de relatie met deze cel steeds rij 107 ?

 

[adkliko]

er is geen vaste relatie tussen de rijen. Behalve dat cel J4 en cel J107 en relatie hebben net zoals J5 dit met J108 heeft.
Belangrijk voor mij is dat hij bovenstaande script goed uitvoerd op een cel. Nu doet hij dit niet helemaal. Probeer maar eens
het lijkt een soort loop in te zitten die ik niet krijg. Gr m.

 

[Warme bakkertje]

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, [H4:IV11]) Is Nothing Then 'de IV moet je nog wijzigen in de juiste laatste kolom !!
    Select Case LCase(Target.Value)
        Case "tvt"
            Cells(Target.Row + 103, Target.Column).Value = InputBox("TVT uren")
        Case Else: MsgBox "Do not Delete"
    End Select
End If
Application.EnableEvents = True
End Sub

 

[adkliko]

klasse Rudi.

bedankt hij werkt prima.