Boucle sur Code

Version imprimable

15/06/2023, 17h46
bobaskis

Boucle sur Code

Bonjour,

J'ai un tableau de plusieurs milliers de ligne, ressemblant à ceci :
Code Employé Numéro formation Intitulé formation Durée réalisée
160 25 Formation 1 150
192 26 Formation 2 420
239 27 Formation 3 840
239 32 Formation 4 0
239 33 Formation 5 200
250 34 Formation 1 400
250 35 Formation 2 420

Un code employé peut apparaitre 1 seule fois ou plusieurs fois (pas de limite), on voit ici que le 160 n'y est qu'une seule fois alors que le 239 y est 3 fois.
J'ai besoin d'une macro qui va exporter dans une nouvelle feuille les données du même employé.
Je n'arrive pas à "compter" le nombre de lignes de chaque employé et donc je n'arrive pas à faire la boucle. je ne sais pas comment passer d'un Code Employé à un autre sachant que le nombre de ligne est variable.
Qui peut m'aider ?
d'avance merci.

bob
15/06/2023, 18h07
Franc

Bonjour,
Par exemple, tu pourrais demander le code de l'employé via un inputbox, créer une nouvelle feuille, parcourir la colonne "Code employé" et chaque fois que tu trouves une correspondance avec l'inputbox tu copies la ligne dans la nouvelle feuille.
Si ce n'est pas ce que tu recherches, tu devrais être plus clair dans le résultat attendu.
15/06/2023, 19h11
bobaskis

et non je ne veux pas passer manuellement d'un code à un autre, je voudrais que la macro le fasse...

Et donc créer une feuille par employé et ce dans le même classeur par exemple ?
Voici ce que je te propose:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub ExportEmployes()
 
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim employe As String
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
 
    Set ws = ThisWorkbook.Sheets("Feuil1") 'Nom de la feuille contenant les données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Dernière ligne de la colonne "Code Employé"
 
    For i = 2 To lastRow 'Boucle pour parcourir chaque ligne (en commençant à la ligne 2 pour ignorer les en-têtes)
        employe = ws.Cells(i, 1).Value 'Récupération du code employé
        On Error Resume Next 'Ignorer les erreurs (si la feuille existe déjà)
        Set newWs = ThisWorkbook.Sheets(employe) 'Tentative de sélectionner la feuille correspondant au code employé
        If Err.Number <> 0 Then 'Si la feuille n'existe pas
            Set newWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Création d'une nouvelle feuille
            newWs.Name = employe 'Renommage de la nouvelle feuille avec le code employé
            ws.Rows(1).Copy newWs.Rows(1) 'Copie des en-têtes dans la nouvelle feuille
        End If
        On Error GoTo 0 'Réactivation des erreurs
        j = newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Row + 1 'Dernière ligne vide de la colonne "Code Employé" dans la nouvelle feuille
        ws.Rows(i).Copy newWs.Rows(j) 'Copie des données dans la nouvelle feuille
    Next i
 
End Sub

15/06/2023, 20h39
bobaskis

merci ça marche
si je comprends bien ton code, ce qui te fait changer de feuille et donc de code employé c'est la détection d'erreur si la feuille n'existe pas en fonction du code que tu as mémorisé ?

est-ce que tu aurais une méthode non pas sur le nom de la feuille mais sur le code employé lui-même ?
15/06/2023, 21h38
Franc

Non, pas du tout. La détection d'erreur c'est pour voir si la feuille existe ou pas. Si elle n'existe pas je la crée en lui donnant comme nom le code de l'employé et si elle existe, j'ajoute les données de l'employé dans sa propre feuille.
C'est ce qui est indiqué dans mes commentaires.
16/06/2023, 08h02
bobaskis

ok , alors comment le code détecte qu'il y a un changement d'employé stp ?
16/06/2023, 10h37
Franc

Parce que je parcours chaque cellule de la colonne "Code employé". Si ce code n'a pas de feuille à son nom, je la crée et je copie la ligne, s'il y a une feuille à son nom alors je copie la ligne dans la feuille.
Suit le déroulé de la macro ligne par ligne avec les commentaires que j'ai ajouté et tu verras que c'est pas compliqué.
16/06/2023, 16h55
bobaskis

oui c'est ce que j'avais compris
est-ce que tu saurais faire une macro un peu différente : on n'exporte pas les codes dans une feuille mais on met une couleur par code, donc les codes identiques ont la même couleur. On ne sait pas combien on a de codes au départ, le fichier étant fluctuant.
En fait ce que je ne sais pas faire c'est un traitement répétitif (ici une couleur) lié à un changement de contenu (ici un code)

désolé je n'ai pas pu répondre pendant la journée.
bob

Je te propose 2 solutions, la première c'est de remplir un tableau avec le code RGB de différentes couleurs. Evidemment si tu as plus de codes employés que de couleurs, tu devras ajouter des couleurs dans le tableau avant de lancer la macro.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub ColorierEmployes()
    Dim ws As Worksheet
    Dim employe As String
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim couleurs As Object
    Dim couleur As Long
    Dim tableauCouleurs As Variant
 
    Set ws = ThisWorkbook.Sheets("Feuil1") 'Nom de la feuille contenant les données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Dernière ligne de la colonne "Code Employé"
    Set couleurs = CreateObject("Scripting.Dictionary") 'Création d'un dictionnaire pour stocker les couleurs
    tableauCouleurs = Array(RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255), RGB(255, 255, 0), RGB(255, 0, 255), RGB(0, 255, 255)) 'Tableau de couleurs prédéfinies (rouge, vert, bleu, jaune, magenta, cyan)
    j = 0 'Compteur pour les couleurs
 
    For i = 2 To lastRow 'Boucle pour parcourir chaque ligne (en commençant à la ligne 2 pour ignorer les en-têtes)
        employe = ws.Cells(i, 1).Value 'Récupération du code employé
        If Not couleurs.Exists(employe) Then 'Si le code employé n'a pas encore de couleur associée
            couleur = tableauCouleurs(j Mod UBound(tableauCouleurs) + 1) 'Récupération de la couleur du tableau (en bouclant si nécessaire)
            couleurs.Add employe, couleur 'Ajout de la couleur au dictionnaire pour ce code employé
            j = j + 1 'Incrémentation du compteur pour les couleurs
        Else 'Si le code employé a déjà une couleur associée
            couleur = couleurs(employe) 'Récupération de la couleur associée à ce code employé
        End If
 
        lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column 'Dernière colonne contenant des données dans cette ligne
        For k = 1 To lastCol 'Boucle pour parcourir chaque cellule jusqu'à la dernière colonne contenant des données
            ws.Cells(i, k).Interior.Color = couleur 'Changement de la couleur de fond de cette cellule
        Next k
    Next i
End Sub

La deuxième c'est d'attribuer des couleurs au hasard, donc si tu exécutes la macro plusieurs fois sur la feuille , les couleurs changent mais elles seront uniques par code employé.
J'utilise une formule pour calculer la luminosité de la cellule, ainsi si la couleur choisie est très sombre, les caractères deviennent blancs et vice-versa, pour plus de lisibilité.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub ColorierEmployesV2()
    Dim ws As Worksheet
    Dim employe As String
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim couleurs As Object
    Dim couleur As Long
    Dim luminosite As Double
 
    Set ws = ThisWorkbook.Sheets("Feuil1") 'Nom de la feuille contenant les données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Dernière ligne de la colonne "Code Employé"
    Set couleurs = CreateObject("Scripting.Dictionary") 'Création d'un dictionnaire pour stocker les couleurs
 
    For i = 2 To lastRow 'Boucle pour parcourir chaque ligne (en commençant à la ligne 2 pour ignorer les en-têtes)
        employe = ws.Cells(i, 1).Value 'Récupération du code employé
        If Not couleurs.Exists(employe) Then 'Si le code employé n'a pas encore de couleur associée
            Randomize 'Initialisation du générateur de nombres aléatoires
            couleur = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)) 'Génération d'une couleur aléatoire
            couleurs.Add employe, couleur 'Ajout de la couleur au dictionnaire pour ce code employé
        Else 'Si le code employé a déjà une couleur associée
            couleur = couleurs(employe) 'Récupération de la couleur associée à ce code employé
        End If
 
        lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column 'Dernière colonne contenant des données dans cette ligne
        For k = 1 To lastCol 'Boucle pour parcourir chaque cellule jusqu'à la dernière colonne contenant des données
            ws.Cells(i, k).Interior.Color = couleur 'Changement de la couleur de fond de cette cellule
 
            luminosite = (0.299 * (couleur Mod 256) + 0.587 * ((couleur \ 256) Mod 256) + 0.114 * ((couleur \ 65536) Mod 256)) / 255 'Calcul de la luminosité de la couleur de fond (formule standard)
            If luminosite < 0.5 Then 'Si la couleur de fond est sombre
                ws.Cells(i, k).Font.Color = RGB(255, 255, 255) 'Changement de la couleur du texte en blanc
            Else 'Si la couleur de fond est claire
                ws.Cells(i, k).Font.Color = RGB(0, 0, 0) 'Changement de la couleur du texte en noir
            End If
        Next k
    Next i
End Sub

16/06/2023, 18h24
umfred

l'utilisation de l'autofiltre (filtre automatique sur les colonnes) ne peut pas résoudre ton questionnement ? avec tri selon la 1ère colonne (éventuellement) Dans tous les cas, en triant, ça sera plus facile pour faire tes boucles.
19/06/2023, 07h52
bobaskis

@Franc : merci pour tes 2 réponses, je teste ça (je n'ai pas pu le faire plus tôt n'ayant eu accès à mon pc du weeke-end)

@umfred : comment dans un filtre tu passes du code1 au code2 au code..X cad comment tu parcours automatiquement dans une macro toutes les possibilités d'un filtre ?

a++
bob

Citation:

Envoyé par bobaskis

@umfred : comment dans un filtre tu passes du code1 au code2 au code..X cad comment tu parcours automatiquement dans une macro toutes les possibilités d'un filtre ?

humm pas possible directement, il faut se créer la liste des éléments avant, par exemple:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Sub test()
    Dim toto As Collection
 
    Set toto = LoadCriteria()
[....]
End Sub
 
Function LoadCriteria() As Collection
    Set LoadCriteria = New Collection
    Dim ws As Worksheet
    Dim i As Integer
    Dim lastRow As Integer
 
    Set ws = ThisWorkbook.Sheets("Feuil1") 'Nom de la feuille contenant les données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Dernière ligne de la colonne "Code Employé"
 
    For i = 2 To lastRow
        If Not IsInCol(Cells(i, 1).value, LoadCriteria) Then
            LoadCriteria.Add Cells(i, 1).value
        End If
    Next i
 
End Function
 
' teste la présence de value dans la collection col
Function IsInCol(value As Variant, col As Collection) As Boolean
    Dim item
 
    IsInCol = False
    For Each item In col
        If item = value Then
            IsInCol = True
            Exit Function
        End If
    Next item
End Function