Planningsbestand

[Finch]

De plaats waar dit dient ingevoerd te worden heb je correct!

Op de eerste rode lijn zet je dit:

.Offset(, r.Offset(, 2).Value - DateSerial(2007, 1, 1) + 1).Value = r.Offset(, 6)

Op de tweede rode lijn dit:

.Offset(, r.Offset(, 2).Value - DateSerial(2007, 7, 1) + 1).Value = r.Offset(, 6)

Finch

 

[Finch]

Ik heb de code nog even bekeken en deze ook wat compacter gemaakt. Onderstaande is dus een alternatieve schrijfwijze:

[FONT="Courier New"]Dim r As Range
Dim rFoundCell As Range
Dim rngPeriode As Range
Dim FirstMonthPeriod As Integer
    
For Each r In Sheets("Invoer").Range("A9:A500")
  
    If r.Value <> "" Then 
        If Month(r.Offset(, 2)) <= 6 Then  'Semester = 1 dwz de maand van de startdatum is jan of feb of maa of apr of mei of jun
            FirstMonthPeriod = 1
            Set rngPeriode = Sheets("planning2").Range("A4:A8")
        Else 'Semester=2
            FirstMonthPeriod = 7
            Set rngPeriode = Sheets("planning2").Range("A12:A16")
        End If
            
        Set rFoundCell = rngPeriode.Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
       
        With rFoundCell
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, FirstMonthPeriod, 1) + 1).Resize(, r.Offset(, 9).Value + 1).Interior.ColorIndex = 15
            .Offset(, r.Offset(, 5).Value - DateSerial(2007, FirstMonthPeriod, 1) + 1).Interior.ColorIndex = 3
            .Offset(, r.Offset(, 2).Value - DateSerial(2007, FirstMonthPeriod, 1) + 1).Value = r.Offset(, 6)
        End With        
    End If
Next r[/FONT]

 

[toverkamp]

Finch,

Superbedankt voor jou hulp!
Hij werkt echt super. De overloop voer ik voorlopig nog wel even handmatig in.
Misschien dat ik binnenkort nog een jaar voor 2008 invoer, of dat ik de bestaande vervang voor 2008. Wanneer ik vragen heb hoor je het wel!

Topper!:thumb: