• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Private Sub Worksheet_Change(ByVal Target As Range)-variant

Status
Niet open voor verdere reacties.

Elleon1971

Gebruiker
Lid geworden
28 aug 2011
Berichten
12
Beste allemaal,

Voor een werkrooster wil ik graag op één tabblad de namen van alle medewerkers bijhouden, in de bijlage op tabblad "Namen". In dit bestand staan alleen fictieve namen. Vervolgens wil ik graag op een ander tabblad deze namen alfabetisch gerangschikt hebben. Dat lukt wel, zie tabblad "Namen + Uren" maar op dit tabblad staat achter de namen nog andere data, in dit voorbeeld het aantal maandelijkse contracturen. Wat ik graag wil, is dat als ik op het tabblad "Namen" een nieuwe medewerker toevoeg onder aan de lijst, bijvoorbeeld "Keesen, Kees", deze nieuwe medewerker op het tabbald "Namen + Uren" verschijnt, alfabetisch gerangschikt en dat de uren in kolom C bij de juiste medewerker blijven staan. Het resultaat zoals het zou moeten worden, staat op tabblad "Resultaat". Uiteraard is het ook de bedoeling dat als ik een medewerker verwijder op het tabblad "Namen", zijn naam en zijn contracturen automatisch verwijderd worden.

Nou heb ik dit al geprobeerd met deze VBA-code op tabblad "Namen + Uren VBA":

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Zodra u de laatste kolom heeft ingevoerd, dan wordt de lijst
'gesorteerd en gaat de cursor naar de volgende lege cel in kolom B.
If Intersect(Target, Range("B2:B21")) Is Nothing Then Exit Sub
    Range("B2:C21").Select
    Selection.Sort _
    Key1:=Range("B2"), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom
    Range("B65536").End(xlUp).Offset(1, 0).Select
End Sub

Het resultaat van deze code is dat de nieuwe naam wel alfabetisch gerangschikt wordt maar dat de contracturen niet mee verschuiven.

Ik hoop dat iemand mij kan helpen.

Groeten, Leo.
 

Bijlagen

  • Rooster Test.xlsm
    20,8 KB · Weergaven: 23
Laatst bewerkt:
Je hebt de uren als waarde gezet achter de namen die via een formule in de cel komt.
Dit gaat altijd mis als je gaat sorteren.
Zet de uren vd werknemers in het zelfde blad als de namen.
Als je de nieuwste versie van excel hebt kun je werken de formule 'unique'
 

Bijlagen

  • Rooster Test_2.xlsm
    12,1 KB · Weergaven: 17
Laatst bewerkt:
Met VBA kan kan het bvb zo. Zorg er wel even voor dat je een kolom invoegt op tabblad "Namen + uren VBA" tussen A en B. (deze kun je vervolgens verbergen)

Edit: bestandje ook maar even bijgevoegd. Macro wordt getriggerd als je een naam toevoegt op tabblad "Namen"

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A1:A100")) Is Nothing And Target.Count = 1 Then
   With Sheets(3)
      
      Set jv = .Range("C1").CurrentRegion
      jv2 = Range("A1", Cells(Rows.Count, 1).End(xlUp))
       
      ReDim ar(UBound(jv2), 1)
      For i = 2 To UBound(jv2)
        If jv2(i, 1) = "" Then Exit For
          x = Application.Match(jv2(i, 1), jv.Columns(1), 0)
          If IsNumeric(x) Then y = jv.Cells(x, 2)
          ar(j, 0) = jv2(i, 1)
          ar(j, 1) = y
          j = j + 1: y = ""
      Next
      
     .Cells(1, 3).CurrentRegion.Offset(1).ClearContents
     .Cells(2, 3).Resize(j, 2) = ar
     .Cells(1, 3).CurrentRegion.Sort .Cells(2, 3), 1, , , , , , xlYes
  End With
 End If
End Sub
 

Bijlagen

  • Rooster Test.xlsm
    26,1 KB · Weergaven: 16
Laatst bewerkt:
Je hebt de uren als waarde gezet achter de namen die via een formule in de cel komt.
Dit gaat altijd mis als je gaat sorteren.
Zet de uren vd werknemers in het zelfde blad als de namen.
Als je de nieuwste versie van excel hebt kun je werken de formule 'unique'

Dank Popipipo voor je antwoord. Het voorbeeldbestand is een sterk versimpelde weergave van het werkelijke bestand. In het voorbeeldbestand heb ik op een tabblad de namen van de werkgever staan en op het andere tabblad de gewerkte uren per maand per werknemer. In werkelijkheid wil ik graag op een tabblad de namen van de werkgevers en op een ander het rooster, de volgende de gewerkte uren per maand op basis van het rooster en op de laatste tab de vakantie, vrij of ziek data. Op dit moment is het zo dat in het rooster de namen van de werknemers op drie tabs bijgehouden moeten worden, hetgeen erg foutgevoelig is.

Jouw oplossing is om de uren op beide tabs te zetten. Ik denk dat dit in mijn werkelijke bestand niet gaan werken. Of zie ik iets over het hoofd?

Maar zeker bedankt voor het meedenken.
 
Laatst bewerkt:
Dank JVeer voor je hulp. In het voorbeeldbestand werkt jouw oplossing perfect maar ik zie dat de VBA-code op het tabblad sheet1 (Namen) staat. Het voorbeeldbestand is een sterk versimpelde versie van het werkelijke bestand. In werkelijkheid wil ik graag op een tabblad de namen van de werkgevers en op een ander het rooster, de volgende de gewerkte uren per maand op basis van het rooster en op de laatste tab de vakantie, vrij of ziek data. Op dit moment is het zo dat in het rooster de namen van de werknemers op drie tabs bijgehouden moeten worden, hetgeen erg foutgevoelig is. Ik wil graag de namen op één tab bijhouden, dit mag in willekeurige volgorde, en dat deze namen alfabetisch op de andere tabs weergegeven worden.

Ik heb in jouw bestand de naam Karel toegevoegd op het tabblad Namen. Op het tabblad "Namen + Uren VBA" wordt nu automatisch Karel alfabetisch toegevoegd waarbij de uren van de overige werknemers achter de juiste naam blijven staan. Exact zoals ik het hebben wil maar ik heb in jouw bestand de tab "Vakantie Vrij" toegevoegd met wat het eindresultaat moet worden. Is dit mogelijk?

Alvast bedankt voor je hulp.

Groeten, Leo.
 

Bijlagen

  • Rooster Test v2.xlsm
    25,8 KB · Weergaven: 17
Laatst bewerkt:
Volgens mij kan ik zelf wel begrijpen wat @popipipo geschreven heeft dus de quoteknop kan je net zo goed niet gebruiken. Als het bestand niet representatief is waarom plaats je het dan? Iedereen kan hier perfecte code schrijven of het eea met formules oplossen. Maar dit gaat natuurlijk allemaal obv van jouw voorbeeldbestand. Als je zelf instaat bent om de suggesties te begrijpen en toe te passen dan is zo'n uitgekleed voorbeeld natuurlijk prima. Dit lijkt er in dit geval niet op.
De code van @JVeer ook al getest?
 
Beste VenA,

Allereerste excuses dat ik de quote-knop gebruikt heb. Ik ben niet een heel erg frequente bezoeker vandaar dat ik niet zo op de hoogte ben van de hier geldende gewoontes. Ik was in de veronderstelling dat het voorbeeldbestand representatief was voor mijn probleem. Gezien de oplossingen van JVeer en Popipipo, bleek dat niet zo te zijn. De oplossing van JVeer komt in de buurt maar lost mijn probleem nog niet helemaal op. Ik heb het oude voorbeeldbestand aangepast zodat het wel zo representatief mogelijk is.
 
Zoiets misschien. Al zou ik je wel aanraden om eens na te denken over een andere opzet

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A1:A100")) Is Nothing And Target.Count = 1 Then
      
      Set jv = Sheets(3).Range("C1").CurrentRegion
      jv2 = Range("A1", Cells(Rows.Count, 1).End(xlUp))
      arr = Array("Namen + Uren VBA", "Vakantie Vrij")
      
      For Each sht In ThisWorkbook.Sheets(arr)
        Set a = IIf(sht.Name = arr(0), sht.Range("C2:C100"), sht.Range("A2:A100"))
        
        For Each cl In a
            If Not IsNumeric(Application.Match(cl, jv2, 0)) And cl <> "" Then cl.EntireRow.Delete
        Next
        
        For Each cl In jv2
            x = Application.Match(cl, a, 0)
            If Not IsNumeric(x) And cl <> "" Then sht.Cells(Rows.Count, IIf(sht.Name = arr(0), 3, 1)).End(xlUp).Offset(1) = cl
        Next
        
        a.CurrentRegion.Sort a.Cells(2, 1), 1, , , , , , xlYes
      Next
 End If
End Sub
 
Laatst bewerkt:
Dank je JV voor je antwoord. Ik heb je nieuwe code op het tabblad "Namen" geplakt en daarna een willekeurige naam, Karel, toegevoegd. Bijgevoegd is het resultaat. Enig idee hoe dit op te lossen?

Alvast bedankt.

Vriendelijke groeten, Leo.
 

Bijlagen

  • Rooster Test v3.xlsm
    27,2 KB · Weergaven: 27
Heb de code in mijn vorige bericht aangepast.
 
Yes, dank je JV. Ik heb de code nog een klein beetje aanpast omdat het woord "Naam" op het tabblad "Namen" ook werd meegekopieerd en gerangschikt op de andere tabs. Daarom

Code:
jv2 = Range("A1", Cells(Rows.Count, 1).End(xlUp))

aangepast naar

Code:
jv2 = Range("A2", Cells(Rows.Count, 1).End(xlUp))

Verder snap ik dat

Code:
arr = Array("Namen + Uren VBA", "Vakantie Vrij")

aangepast en uitgebreid kan worden.

Kun je me nog wel op weg helpen hoe ik deze code kan aanpassen als ik dit wil uitbreiden met extra regels en kolommen?

Groeten, Leo.
 

Bijlagen

  • Rooster Test v4.xlsm
    27,2 KB · Weergaven: 19
Dat zou al goed kunnen gaan zonder iets aan te passen
 
Ik heb het testbestand uitgebreid met een extra tab en de code met deze extra tab aangepast. Zoals jij aangeeft, werkt het op deze extra tab goed maar in de eerste tab na het tabblad "Namen" worden de namen in kolom C gezet. Is het mogelijk om in het tabblad "Uren" (dus de eerste tab rechts van het tabblad met de code) de namen in kolom A te zetten? Ik heb geprobeerd de code aan te passen maar ze blijven in kolom C terecht komen. Mijn kennis van VBA is dus echt te beperkt.
 

Bijlagen

  • Rooster Test v5.xlsm
    21,4 KB · Weergaven: 16
Probeer eens te achterhalen wat de rood gekleurde code doet, waarschijnlijk kom je er dan wel uit.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A1:A100")) Is Nothing And Target.Count = 1 Then
      
      Set jv = Sheets(3).Range("C1").CurrentRegion
      jv2 = Range("A2", Cells(Rows.Count, 1).End(xlUp))
      arr = Array("Uren", "Vakantie Vrij", "Week")
      
      For Each sht In ThisWorkbook.Sheets(arr)
        [COLOR="#FF0000"]Set a = IIf(sht.Name = arr(0), sht.Range("C2:C100"), sht.Range("A2:A100"))[/COLOR]
        
        For Each cl In a
            If Not IsNumeric(Application.Match(cl, jv2, 0)) And cl <> "" Then cl.EntireRow.Delete
        Next
        
        For Each cl In jv2
            x = Application.Match(cl, a, 0)
            If Not IsNumeric(x) And cl <> "" Then sht.Cells(Rows.Count, [COLOR="#FF0000"]IIf(sht.Name = arr(0), 3, 1)[/COLOR]).End(xlUp).Offset(1) = cl
        Next
        
        a.CurrentRegion.Sort a.Cells(2, 1), 1, , , , , , xlYes
      Next
 End If
End Sub
 
Dank je Albert, probleem opgelost. Ik had het eerste rode gedeelte al aangepast maar dat was niet voldoende. Zoals ik al zei, is mijn VBA-kennis onvoldoende. Ik heb nu in het twee rode gedeelte de "3" verandert in een "1" en het probleem is opgelost.

Allen bedankt die meegeholpen hebben.

Voor de volledigheid de laatste, werkende versie toegevoegd.
 

Bijlagen

  • Rooster Test v6.xlsm
    21,7 KB · Weergaven: 17
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan