verschuiven

[wacco]

Hallo,

Ik wil graag dat door het invullen van een waarde in een cel, dat deze waarde een aantal cellen wordt doorgevoerd met deze zelfde waarde.
Het aantal cellen wat opzij moet worden doorgevoerd, is afhankelijk van de waarde welke wordt ingegeven, en wordt gehaald uit een index.
Voor de duidelijkheid, heb ik een voorbeeld bijgevoegd.
Ik hoop dat iemand mij kan helpen.

Gr,

 

[Leotaxi]

iets in deze aard ?


mvg
Leo

 

[wacco]

@Leo
Bedankt.
Zoiets zou het moeten zijn,....maar dan voor de volledige 52 weken en met willekeurige waarden
Dus als ik ergens een willekeurige waarde binnen de range van weken invul, dan moet vanaf daar het "verschuiven" beginnen.
Elke waarde moet kunnen worden ingevuld, kleur wordt dan aangepast met voorwaardelijke opmaak.
De range van waarden wordt in de "Index" omschreven (Waarde van, tot)
Is dit mogelijk??

Gr,

 

[Leotaxi]

Kan je een voorbeeldje geven (in excel file) van gewenst resultaat ?

mvg
Leo

 

[Leotaxi]

meer zo dan ?


mvg
Leo

 

[wacco]

@Leo,
Hartelijk dank voor je snelle reactie.
Je oplossing komt in de buurt, maar is niet precies wat ik graag zou willen.
Komt waarschijnlijk door mijn wat onduidelijke vraagstelling.
Ik heb een nieuw voorbeeldje erbij gedaan, waarin staat wat de bedoeling is.
Ik hoop dat het nu wat duidelijker is wat de bedoeling is.
Ik hoop dan ook, dat je de tijd hebt om er nog eens naar te kijken.

B.v.d.

Gr,

 

[VenA]

Wat moet er gebeuren als bv iets in week 52 ingevoerd wordt? Of loopt de kalender in werkelijkheid verder door. Even uitgaande van het laatste kan je deze proberen.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H13:BG32")) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    With Target
    If .Value > 0 And .Value < 109 Then
        .Offset(, 1).Resize(, Application.Lookup(.Value, Array(1, 51, 76, 101), Array(1, 2, 4, 8))) = .Value
    End If
    End With
    Application.EnableEvents = True
End If
End Sub

 

[wacco]

@VenA
Dankje voor de snelle reactie.
Ik heb het net ff getest.
Bleek dat bij invullen van een waarde >109, het niet werkte.
Ik heb de volgende regel aangepast (109 =126 geworden)

If .Value > 0 And .Value < 126 Then

Daarna werkte het perfect.

Voorlopig wil ik het beperken tot het invullen tot week 52.
Daarna invoer gedeelte wissen, en opnieuw beginnen met invullen.
Is niet de meest elegante manier, maar zie voorlopig geen andere manier om dit anders te doen.
De laatste ingevoerde waarde per rij, wordt weer voor een ander doel gebruikt.

Maar voorlopig kan ik (gelukkig) weer verder.
Normaals hartelijk dank.

Gr,

 

[HSV]

Als je de intervallen nog een keer wil aanpassen in het werkblad.

.Offset(, 1).Resize(, Application.Lookup(.Value, [COLOR=#FF0000]range("a4:b7"), range("d4:d7"))) [/COLOR]= .Value

 

[wacco]

@HSV,
Goed idee, maakt het nog makkelijker.
Bedankt :thumb:

Gr,

 

[wacco]

hallo,

Loop toch nog tegen een probleem aan.
Als ik het einde bereik van de range, bv BE13, en ik geef hier dan een waarde van 120 in dan krijg ik een fout melding.
De cel waarde zou dan eigenlijk 8 cellen verder door gezet moeten worden, maar dat is niet mogelijk.
Hoe kan ik ondervangen, dat wanneer met een invoer het einde wordt bereikt, het verder doorvoeren van de waarde stopt in de laatste cel van het bereik.
Hopelijk kan iemand mij helpen.

Gr,

 

[VenA]

Je kan deze eens proberen

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H13:BG32")) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    With Target
    If .Value > 0 And .Value < 126 Then
        t = Application.Lookup(.Value, Range("a4:b7"), Range("d4:d7"))
        If .Column <> 59 Then
            If .Column + t > 59 Then .Offset(, 1).Resize(, 59 - .Column) = .Value Else .Offset(, 1).Resize(, t) = .Value
        End If
    End If
    End With
    Application.EnableEvents = True
End If
End Sub

Je kan If .Column <> 59 Then eventueel weglaten door de target range met één kolom te verkleinen.

Dan wordt het

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H13:BF32")) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    With Target
        If .Value > 0 And .Value < 126 Then
            t = Application.Lookup(.Value, Range("a4:b7"), Range("d4:d7"))
            If .Column + t > 59 Then .Offset(, 1).Resize(, 59 - .Column) = .Value Else .Offset(, 1).Resize(, t) = .Value
        End If
    End With
    Application.EnableEvents = True
End If
End Sub

 

[wacco]

@VenA,

Beide opties werken niet.
Als ik nu een waarde invul van bv 110, dan wordt enkel deze cel 110.
En niet de daaropvolgende 8
Ook als ik ergens midden in deze waarde invul gebeurt hetzelfde (enkele cel krijgt waarde)
Ik hoop dat je nog wat tijd kan vinden, om nog eens verder te kijken.

B.v.d.

 

[HSV]

Laat dat eens met een bestand zien.
Zoals ik het kan beoordelen werkt het prima en worden er 9 cellen gegeven met de waarde van 110.

 

[Leotaxi]

andere wijze

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column >= 7 And Target.Column < 61 And Target.Count = 1 Then
    If Target <> vbNullString Then
    r = Application.VLookup(Target, Range("A4", "D7"), 4, True)
    For Each cl In Range(Target.Offset(, 1), Target.Offset(, r))
        If cl.Column < 60 Then cl.Value = Target
    Next
    End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

mvg
Leo

 

[wacco]

@HSV,
Ik heb het net ff geprobeert in het test bestandje,.....en inderdaad hier werkt het.
In mijn werkelijke sheet gaat er iets fout.
Ik zoek ff verder.

Gr,

 

[wacco]

@LeoTaxi

Leo,
Ik heb jou code nu gebruikt, en inderdaad deze werkt.
Ik heb alleen de column verwijzingen aangepast aan mijn sheet ( is iets anders dan het test sheet)

Zelfde fout had ik gemaakt, bij de oplossing van VenA.
Deze optie werkt dus ook.
Beetje stom, om dat eerst niet op te merken.

Allen, HSV, VenA en LeoTaxi bedankt.

Gr,

 

[HSV]

Zelf de fouten herstellen is de beste leermethode.