Recherche des valeurs dans une colonne

Bonjour le Forum et meilleurs vœux pour l'année 2024,https://forum.excel-pratique.com/post/nouveau/2#

Je me permets de demander votre aide pour résoudre le petit problème suivant concernant le fichier ci-joint:

- Il y a une liste des volontaires, l'onglet MEMBERS.

- Les volontaires donnent leurs disponibilités pour le mois prochain, l'onglet 01_2024 pour janvier etc. Pas forcément que tous les volontaires répondent. L'onglet Forms 01_2024

- Le planificateur décide qui sera appelé en mettant la chiffre 1 dans cet onglet, minimum 2 personnes et maximum 4 pour une équipe. L'onglet 01_2024.

- Le but est d'automatiser l'onglet 01_2024_shifts. C'est à dire pour chaque ligne de VS1 de cet onglet, retrouver tous les volontaires qui ont la chiffre 1 dans l'onglet 01_2024 en mettant dans la colonne B leur ID. Pour VS1 on 2 volontaires 1202 et 1207, pour VS2 on a 3 personnes 1203, 2102 et 2204... jusqu'à la dernière ligne de l'onglet 01_2024_shifts. une fois le remplissage est fini, masquer les lignes pour lesquelles il n'y a pas des volontaires.

Merci d'avance et bonne journée.

Baton

Bonjour Baton

Waouh cela fait longtemps que l'on ne s'est plus parlé

Essaie avec ces deux codes placés dans un module.

Sub maj_shift()
Dim volontaire As String, ID As String
Dim i As Integer, dcol As Integer, dlig As Integer
Dim c As Range
Dim prem

With Sheets("01_2024_shifts")
    .Range("B3:B" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents 'effacer les donnees colonne B
End With

With Sheets("01_2024")
    dcol = .Cells(5, Cells.Columns.Count).End(xlToLeft).Column - 2
    dlig = .Cells(Rows.Count, 1).End(xlUp).Row

    For i = 4 To dcol

        If WorksheetFunction.CountIf(.Range(.Cells(6, i), .Cells(dlig, i)), "=1") >= 1 Then
            With .Range(.Cells(6, i), .Cells(dlig, i))
                Set c = .Find(1, LookIn:=xlValues)
                If Not c Is Nothing Then
                    prem = c.Address
                    Do
                        volontaire = Sheets("01_2024").Cells(5, i)
                        ID = Sheets("01_2024").Cells(c.Row, 1)

                        Call shift(volontaire, ID)
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> prem
                End If
            End With
        End If

    Next i
End With
End Sub

Sub shift(volontaire As String, ID As String)
Dim i As Byte

With Sheets("01_2024_shifts")
    For i = 3 To .Range("A" & Rows.Count).End(xlUp).Row
        If .Cells(i, 2) = vbNullString And .Cells(i, 1) = volontaire Then
            .Cells(i, 2) = ID
            Exit For
        End If
    Next i
End With
End Sub

Pour exécuter, cliquez sur la ligne Maj_shift du code maj_shift puis appuyer sur la touche F5 (ou FN +F5)

Le code fonctionne évidemment sur les feuilles du fichier posté

Passe un bon réveillon.

Cordialement

Hello Dan,

Bonne année et meilleurs vœux pour 2024.

Comme d'habitude, tes macros fonctionnent parfaitement.

Un immense merci pour ton support!!!

Cordialement,

Baton