Sorteren rooster

[don42]

Hallo allemaal,

Ik ben bezig met het maken van een roulering
Bekijk bijlage hans2.rar

Private Sub CommandButton21_Click()
Dim lastrow, at, x As String
lastrow = Blad6.Range("a" & Rows.Count).End(xlUp).Row
x = 2
For at = 1 To lastrow
If Blad6.Range("a" & at).Value = Cells(x, 3) Then
Range("d" & x).Resize(1, 14).Value = Blad6.Range("b" & at, "o" & at).Value
x = x + 1
End If
Next
End Sub

dit is de code die ik heb
Probeer het uit te leggen waar het fout gaat
we werken met een roulering van 96 weken
als ik een chauffeur kies zoals in de bijlage die in week 12 zit dan dan stopt mijn code bij week 96
maar zou dan eigenlijk weer met week 1 door moeten gaan
hoop dat de bijlage duidelijk kan maken wat ik vraag
kies in tabblad chauffeurs in de gele cel een naam (je ziet dan het weeknummer = nu 12)
klik op de knop in tabblad op naam, het andere tabblad geeft de originele rooster weer

hoop dat iemand begrijpt wat ik bedoel
en me kan helpen

 

[zapatr]

Dit werkt bij mij:

Private Sub CommandButton21_Click()
Dim lastrow1 As Integer, lastrow2 As Integer, x As Integer, y As Integer
lastrow1 = Cells(Rows.Count, 3).End(xlUp).Row - 2
Range("D2:Q" & lastrow1).ClearContents
With Blad6
    Application.ScreenUpdating = False
    lastrow2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        For x = 2 To lastrow1 Step 3
            For y = 2 To lastrow2
                If Cells(x, 3).Value = .Cells(y, 1) Then
                    .Range("B" & y & ": O" & y + 2).Copy Range("D" & x & ":Q" & x + 2)
                End If
            Next y
        Next x
    Application.ScreenUpdating = True
End With
End Sub

Je commandbutton heeft 21 als nummer, heb je misschien te maken gehad met het probleem dat op onderstaande webpagina wordt beschreven?
http://support2.microsoft.com/kb/3025036/nl

 

[don42]

Hoi Zapatr

hey super die code werkt geweldig
Zou je mij kort de werking uit willen leggen van de code

hou er van als iets werkt maar begrijp ook graag wat er gebeurd
je zou mij er een groot plezier mee doen.

nu ga ik even werken aan die commandbutton 21 hoop dat dat ook opgelost kan worden maar bovenstaande heeft mijn prioriteit



Don

 

[don42]

Is de code van #1 niet aan te passen?
Die is volgens mij veel sneller

 

[zapatr]

Don 42 schreef: "Is de code van #1 niet aan te passen? Die is volgens mij veel sneller."
Snel tevreden ben je kennelijk niet.
Natuurlijk is die code veel sneller, maar wat heb je aan een snelle code als die niet deugt? Behalve dat er niet altijd naar het juiste blad wordt verwezen, betrek je ook niet alle noodzakelijke waarden in de berekening. Een snellere oplossing dan die in bericht #2 is er overigens wel (niet gebaseerd op jouw code), maar daar ga ik nu niet aan beginnen; wellicht anderen wel.
Hieronder de uitleg waar je om vroeg, alhoewel ik vind dat die niet nodig zou moeten zijn omdat er slechts basisopdrachten in worden gebruikt.

Private Sub CommandButton21_Click()
[COLOR="#0000CD"]'Alle cellen en bereiken waar een punt voor staat, hebben betrekking op Blad6,
'en die waar geen punt voor staat op Blad5[/COLOR]

Dim lastrow1 As Integer, lastrow2 As Integer, x As Integer, y As Integer
[COLOR="#0000CD"]'Bovenstaande varibalen zijn gehele getallen en worden daarom als dusdanig gedeclareerd.[/COLOR]

lastrow1 = Cells(Rows.Count, 3).End(xlUp).Row - 2 'de rijen tellen
[COLOR="#0000CD"]'Laatste rij van kolom C in Blad5 met een geheel getal (de laatste 2 getallen zijn geen
'gehele getallen).De gegevens van elke week staan in 3 rijen, waarvan alleen telkens het
'getal in de eerste rij in kolom C een geheel getal is. Omdat de gegevens in kolom A van
'Blad6 (waarmee de getallen van kolom C in Blad5 vergeleken moeten worden) ook louter uit
'gehele getallen bestaan, worden alleen die gehele getallen vergeleken.[/COLOR]

Range("D2:Q" & lastrow1).ClearContents 'duidelijk
With Blad6
Application.ScreenUpdating = False 'ik denk voor snelheidwinst maar kan er goed naast zitten
[COLOR="#0000CD"]'Dat is goed gedacht en daarnaast wordt flikkering van het scherm voorkomen. Alle acties 
'worden niet onmiddellijk op het scherm getoond, dat gebeurt pas als Screenupdating op True 
'wordt geplaatst (zie onderaan). Omdat de bewerkingen niet erg veel rijen omvatten, kun je 
'die opdracht ook weglaten (als je dat doet, moet je ook de False-opdracht onderaan weghalen).[/COLOR]

lastrow2 = .Cells(.Rows.Count, 1).End(xlUp).Row 'Tellen cellen van  kolom A van blad6 -> juist.
For x = 2 To lastrow1 Step 3
[COLOR="#0000CD"]'Doorloop kolom C van Blad5 vanaf C2 en sla telkens 2 rijen over omdat alleen naar gehele
'getallen moet worden gekeken.[/COLOR]

For y = 2 To lastrow2
[COLOR="#0000CD"]'Doorloop kolom A van Blad6 vanaf A2 en sla hier geen cellen over.[/COLOR]

If Cells(x, 3).Value = .Cells(y, 1) Then
.Range("B" & y & ": O" & y + 2).Copy Range("D" & x & ":Q" & x + 2)
End If
[COLOR="#0000CD"]'Als een celwaarde van kolom C in blad5 overeenkomt met een celwaarde in kolom A van Blad6,
'kopieer dan van Blad6 de rij met die celwaarde + de twee rijen daaronder (samen de gegevens
'van 1 week vormend) naar Blad5.[/COLOR]

Next y
Next x
Application.ScreenUpdating = True
End With
End Sub

 

[don42]

How,
Sorry zaptar ik wil het zeker niet laten overkomen dat ik het niet waardeer wat er hier op het forum gedaan word
in tegen deel.
en bedankt dat je toch die uitleg hebt gemaakt
deze gaat weer in mijn map

 

[don42]

Graag een hint:
moet ik het proberen met Vlookup?

 

[zapatr]

Nee, geen vlookup, gewoon twee keer kopiëren.
Eerst het gedeelte van het gekozen plaatsnr. t/m 96 en daarna van 1 tot dat nummer.
Je krijgt dan dit:

Private Sub ComboBox1_Change()
Dim getal As Integer, x As Integer, lastrow As Integer
'Deze macro werd geschreven door Zapatr
getal = Sheets("Chauffeurs").Range("E2").Value
With Sheets("Roulering normaal")
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
x = WorksheetFunction.Match(getal, .Range("A1:A" & lastrow))
.Range("B" & x & ":O" & lastrow).Copy Sheets("Op naam normaal").Range("D2")
.Range("B2:O" & x - 1).Copy Sheets("Op naam normaal").Range("D" & lastrow - x + 3)
End With
End Sub

Als je deze macro verbindt aan een combobox in D2 op het eerste blad (zoals ik in deze macro heb gedaan), dan heb je op het tweede blad geen knop meer nodig. Zodra je na het kiezen van een naam in die combobox naar het tweede blad gaat, is de lijst daar al volledig aangepast aan de gekozen naam in het eerste blad. Voor die combobox stel je als bereik in: A1:A83 en als 'linked cell' vul je in: D2.

Een andere mogelijkheid (dus niet tegelijkertijd uit te voeren met de oplossing hierboven) is om in het tweede blad in B2 gegevensvalidatie in te stellen. In het eerste blad maak je D2 dan gelijk aan B2 van het tweede blad en bij elke keuze in B2 verschijnen dan ook meteen de gegevens. Dit doe je met een 'Private Change'. Met die oplossing moet je niet steeds switchen tussen het eerste en tweede blad.

- Jouw bestand werkt op mijn computer niet goed, het lijkt corrupt. Ik heb de gegevens naar een nieuw bestand moeten kopiëren.
- En jouw eerste blad heeft als naam Chauffeurs , met een spatie na de s. Haal die spatie weg.

 

[don42]

Dit werkt super dank je wel
met die combobox krijg ik niet voor elkaar daar ga ik nog even mee aan de slag
maar met button werkt het wel. Top
ik krijg in cel D2 een getal

 

[zapatr]

Als er in D2 een getal komt, dan heb je waarschijnlijk een combobox (keuzelijst met invoervak) gekozen uit de set FORMULIER-besturingselementen. Nu is dat getal wel om te zetten naar de bijbehorende naam, maar hier lijkt het mij eenvoudiger om de combobox (keuzelijst met invoervak) te kiezen uit de ACTIVE-X-besturingselementen, daar is ook mijn tekst in bericht #8 op gebaseerd. Als je die combobox hebt geplaatst, klik er dan op met de rechtermuisknop, kies Eigenschappen, vul in bij Listfillrange: A2:A83 en bij LinkedCell: D2. Sluit het venster, klik nogmaals met de rechtermuisknop op de combobox, kies: "Programmacode weergeven" en plaats daar de macro uit bericht #8. Dan ben je klaar.

 

[don42]

Super bedankt voor je fijne hulp:thumb:

 

[zapatr]

In de bijlage de tweede mogelijkheid die ik in bericht 8 noemde, misschien heb je er wat aan.
Maak een keuze in B2 van het tweede blad, de combobox in het eerste blad vervalt dan.
(Ik kan niet altijd bestanden uploaden, anders had ik dat voor vorige oplossingen ook gedaan).

 

[don42]

Nou daar ben ik zeker blij mee erg mooi gedaan
Don