Zoeken in rooster

[Danielle22]

Hallo allemaal,

Ik heb een klein probleempje met Excel. Ik heb namelijk een rooster en daar moet ik dan bepaalde diensten in zoeken. Dus als er een dienst nodig is dan moet ik nu de hele lijst nakijken wie die dienst allemaal kunnen werken.

Ik het ook mogelijk dat een macro deze diensten met de daarbij horende werknemer voor mij zoekt? Ik heb ook een bijlage toegevoegd.

Dus als ik dan naar het blad aanvragen ga (zie voorbeeld). En daar de datum, soort dienst en afdeling invul dat die dan automatisch de naam van de werknemer erbij zoek (incl. tel en email) uit het blad rooster.

Alvast heel er bedankt voor de geboden hulp.

Met vriendelijke groet,

Danielle

 

[Wigi]

Heb niet echt getest, maar hier is een oplossing met een aantal lussen en IFkes.

Sub HaalGegevensOpWigi()

    Dim r1 As Range
    Dim l As Long
    Dim rBegincel As Range
    
    For Each r1 In Sheets("Aanvragen").Range("A2:A2")
    
        If Len(r1.Value) > 0 Then
        
            r1.Offset(0, 3).Resize(1, 15).ClearContents
        
            For l = 2 To Sheets("Rooster").Range("B" & Rows.Count).End(xlUp).Row Step 6
            
                Set rBegincel = Sheets("Rooster").Range("B" & l)
                
                If rBegincel.Offset(3, -1).Value = r1.Offset(0, 2).Value Then
                
                    For i = 1 To 3
                    
                        If rBegincel.Offset(i).Value = r1.Offset(0, 1).Value Then
                    
                            For j = 3 To 33
                            
                                If rBegincel.Parent.Cells(rBegincel.Row, j).Value = r1.Value Then
                                
                                    If rBegincel.Parent.Cells(rBegincel.Row + i, j).Interior.ColorIndex = 4 Then
                                
                                        'kandidaat gevonden
                                        r1.Parent.Cells(r1.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = rBegincel.Offset(0, -1).Value
                                        r1.Parent.Cells(r1.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = rBegincel.Offset(1, -1).Value
                                        r1.Parent.Cells(r1.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = rBegincel.Offset(2, -1).Value
                                    
                                    End If
                                
                                End If
                            
                            Next
                            
                        End If
                    
                    Next
                
                End If
            
            Next
            
        End If
        
        r1.Resize(1, 18).EntireColumn.AutoFit
    
    Next

End Sub

Wigi

 

[Danielle22]

Hoi Wigi,

Bedankt voor je reactie. Ik heb nu de code in VBA gezet, maar de vba zoekt op dit moment nog niks. Ik heb maar een heel klein beetje verstand van VBA . Zou je me kunnen vertellen wat er precies gebeurd? En hoe ik de code kan aanpassen zodat die het wel doet.

Alvast heel erg bedankt voor de hulp.

Groetjes,

Danielle

 

[Warme bakkertje]

Al je datums op tabblad rooster stonden op jaartal 1900. Heb ze allemaal aangepast naar 2008 en heb macro toegevoegd op tabblad aanvragen zodat bij wijziging in kolom C het zoeken automatisch start.
Probeer het nu eens uit.

Rudi

 

[Danielle22]

Hoi,

Oh, dus het lag aan de datum. Heel erg bedankt voor je hulp :thumb:.

Heel erg mooi systeem dat VBA. Moet ik me toch maar eens wat meer in verdiepen!

Groetjes,

Danielle

 

[Wigi]

Graag gedaan Danielle :thumb:

Ga met toets F8 stap voor stap door de code en dan zal het wat duidelijker zijn wat er gebeurt.

Doordat het lussen zijn is het niet super moeilijk te begrijpen.

Wigi