aanpassen macro

[Mde]

Hoi,

Voor ons werk hebben we een aantal monteur die oproepbaar zijn.
Hiervan is een rooster die mbv een macro gemaakt word, dit werkt.
Nu is mijn vraag omdat het aantal monteurs soms wisselt dan 3 volgende keer bv 5 of 4 is het mogelijk om de macro zo aan te passen dat die kijkt op blad 1
hoeveel monteurs er ingevuld zijn en dat die dan automatisch de gegevens invult zonder her en der wat aan te passen in de macro.


Als er vragen zijn hoor ik het wel

BVD
Bekijk bijlage Kopie van Cons-MTD4-Monteurs_2016 4 monteurs.xlsm

 

[Cobbe]

Pas dit gedeelte eens aan:

Sheets("Eerste-3").Select

Sheets("Eerste-3").Unprotect
Sheets("Tweede-3").Unprotect
Sheets("Derde-3").Unprotect
Sheets("Vierde-3").Unprotect

With sheets("Blad1")
For i = 7 To .Range("C" & .Rows.Count).End(xlUp).Row
   monteur_naam(i - 6) = .Cells(i, 3).Value
   monteur_telefoon(i - 6) = .Cells(i, 4).Value
   monteursit(i - 6) = i - 6
Next
End with

 

[Mde]

Hallo Cobbe,

dit werkt inderdaad, alleen nu worden de monteurs 5 en 6 niet meegenomen in de planning.
Hiervoor moet nog wat aangepast worden waaronder dit stukje bij 5 zou 29 35 moeten zijn is dit ook nog aan te passen?

  situatieteller = situatieteller + 1
   datum = datum + 1
   If situatieteller = [COLOR="#FF0000"]29[/COLOR] Then
   situatieteller = 1

en dan liefst zo dat op donderdag de wissel van monteurs is

 

[Cobbe]

Test hem zo eens.

 

[Mde]

Hoi Cobbe,

Bijna monteur 1 loopt nu meer als de rest.
Het is in princiepe de bedoeling dat iemand 7 dagen achter elkaar loopt en dat dan op donderdag de wissel plaats vind.
Misschien moeten we helemaal opnieuw beginnen , deze file heeft iemand gemaakt die hier niet meer werkt.

In ieder geval bedankt voor dit bestand en de moeite. :thumb:

 

[Cobbe]

Misschien moeten we helemaal opnieuw beginnen

Dit lijkt me ook beter, het is altijd moeilijk om de gedachtengang van een voorganger te doorgronden.

 

[Mde]

Iemand een voorstel hoe te beginnen?
Qua layout zo ongeveer als dat het was mag anders als makkelijker is

 

[HSV]

Zet dit stuk eens op dezelfde plaats

Sheets("Eerste-3").Unprotect
Sheets("Tweede-3").Unprotect
Sheets("Derde-3").Unprotect
Sheets("Vierde-3").Unprotect




[COLOR=#0000ff]sn = Blad1.Range("c7:d12")[/COLOR]
[COLOR=#0000ff]For i = 1 To UBound(sn)[/COLOR]
[COLOR=#0000ff]monteur_naam(i) = sn(i, 1) [/COLOR]'Worksheets("Blad1").Cells(7, 3).Value
'monteur_naam(2) = Worksheets("Blad1").Cells(8, 3).Value
'monteur_naam(3) = Worksheets("Blad1").Cells(9, 3).Value
'monteur_naam(4) = Worksheets("Blad1").Cells(10, 3).Value
'monteur_naam(5) = Worksheets("Blad1").Cells(11, 3).Value
'monteur_naam(6) = Worksheets("Blad1").Cells(12, 3).Value


[COLOR=#0000ff] monteur_telefoon(i) = sn(i, 2)[/COLOR]
'monteur_telefoon(2) = Worksheets("Blad1").Cells(8, 4).Value
'monteur_telefoon(3) = Worksheets("Blad1").Cells(9, 4).Value
'monteur_telefoon(4) = Worksheets("Blad1").Cells(10, 4).Value
'monteur_telefoon(5) = Worksheets("Blad1").Cells(11, 4).Value
'monteur_telefoon(6) = Worksheets("Blad1").Cells(12, 4).Value
[COLOR=#0000ff]Next i[/COLOR]


weekdag(1) = "Zo"
weekdag(2) = "Ma"
weekdag(3) = "Di"
weekdag(4) = "Wo"
weekdag(5) = "Do"
weekdag(6) = "Vr"
weekdag(7) = "Za"

 

[Mde]

Hallo HSV,

Helaas doet die allen de eerste 4 maar.

Bedankt voor de moeite:thumb:

 

[Ginger]

Goeiedag wat een procedure bevat dat workbook... :shocked:
Van scratch af aan beginnen lijkt mij ook het beste. Je springt zó ontzettend heen en weer dat er nauwelijks een touw aan vast te knopen is. Daarnaast kunnen al die vullingen van de array's héél wat simpeler gevuld worden dan element voor element uit te schrijven. Wel een geinig project (en als ik 't niet zo retedruk op m'n werk had, was ik er nog in gedoken ook).

 

[HSV]

Ik ga niet het hele bestand op de schop nemen.
Alleen werkend lijkt me daarom ook voldoende.

Test het maar eens.

 

[Mde]

Hallo,

Sorry voor late reactie was een weekendje weg.
HSV werkt dank U.

@ Ginger hou me aanbevolen als je tijd en zin hebt om hem opnieuw te maken.

Iedereen bedankt :thumb:

 

[pasan]

12 maanden onder elkaar
voeg een blad toe met de naam "nieuw" zodat je kunt zien en testen of het werkt

Sub NieuwRoosterMaken()

Dim maand(1 To 365, 1 To 4)
naamtelefoon = Worksheets("Blad1").Cells(7, 3).CurrentRegion



    roosterbeginmaand = CInt(Application.InputBox("Welke maand beginnen :??? ( maand 1 , 2 ,3 enz)"))
    
    Select Case roosterbeginmaand
    Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
    Case Else
    MsgBox "verkeerde maand ingegeven (in cijfers 1 tot 12)"
    Exit Sub
    End Select
    

    
    roosterbeginjaar = CInt(Application.InputBox("Welk jaar  :??? ( 2011 , 2012 , enz)"))
    
    Select Case roosterbeginjaar
    Case 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020
    Case Else
    MsgBox "verkeerd jaar ingegeven (in cijfers )"
    
    Exit Sub
    End Select


 For j = 1 To 365
   If Not IsError(Format(DateSerial(roosterbeginjaar, roosterbeginmaand, Format(j, "d") + j), "d")) Then maand(j, 1) = CDate(Format(DateSerial(roosterbeginjaar, roosterbeginmaand, j), "dd-mm-yyyy"))
   maand(j, 2) = Format(DateSerial(roosterbeginjaar, roosterbeginmaand, j), "d")
 Next j
 
 a = 1
 On Error Resume Next
 For i = 0 To UBound(maand) Step 7
 
   For jj = 1 To 7
     maand(i + jj, 3) = naamtelefoon(a, 2)
     maand(i + jj, 4) = naamtelefoon(a, 3)
   Next jj
   a = a + 1
   If a > UBound(naamtelefoon) Then a = 1
   
 Next i
 On Error GoTo 0
 Worksheets("nieuw").Cells(2, 2).Resize(UBound(maand, 1), UBound(maand, 2)) = maand

End Sub

 

[HSV]

Het eerste wat me opviel.

Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12

case 1 to 12

 

[Mde]

Ik heb er dit van gemaakt
Kan vast beter, voor mij werkt het zo


Bekijk bijlage consignatie leeg.xlsm