Microsoft 365 Liste critère détaillé lors d'une macro

Chounoé

XLDnaute Nouveau
Bonjour à tous et à toute, pouvez-vous m'éclairer sur un point, lors d'une macro, j'ai une base de donnée que je voudrais filtrer avec un critère bien défini, l'ennui c'est que la macro prend en compte toute les données du critère. Y-a t'il une méthode pour qu'elle généralise le tout. Ci-joint le fichier Excel. Voir la macro MAJ CC.

Merci
 

Pièces jointes

  • Classeur1.xlsm
    26.2 KB · Affichages: 5

Franc58

XLDnaute Occasionnel
Salut, je ne sais pas si tu as une raison particulière de faire 3 macros différentes, en voici une qui traite tous les critères, adapte si nécessaire:

VB:
Sub CopyCells()
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim data As Variant
    Dim results As Collection
    Dim colors As Collection
    Dim prefix As Variant
    Dim prefixes As Variant
    Dim i As Long
    Dim j As Long
    Dim nextRow As Long

    ' Feuille source
    Set wsSource = ThisWorkbook.Sheets("Base de données")

    ' Lire toutes les données dans un tableau en mémoire
    data = wsSource.Range("A2:C" & wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row).Value

    ' Définir les préfixes à vérifier
    prefixes = Array("CC", "CB", "CHU")

    ' Parcourir chaque préfixe
    For Each prefix In prefixes
        ' Créer une nouvelle collection pour stocker les résultats et les couleurs pour ce préfixe
        Set results = New Collection
        Set colors = New Collection

        ' Parcourir chaque ligne de données
        For i = 1 To UBound(data, 1)
            ' Si la cellule commence par le préfixe actuel, ajouter la ligne et la couleur au tableau de résultats
            If Left(data(i, 1), Len(prefix)) = prefix Then
                results.Add Array(data(i, 1), data(i, 2), data(i, 3))
                colors.Add wsSource.Cells(i + 1, "A").Interior.Color
            End If
        Next i

        ' Si des résultats ont été trouvés, les écrire sur la feuille de destination
        If results.Count > 0 Then
            ' Feuille de destination
            Set wsDestination = ThisWorkbook.Sheets(prefix)

            ' Trouver la première ligne vide dans la colonne A de la feuille de destination
            nextRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1

            ' Écrire les résultats et les couleurs sur la feuille de destination
            For i = 1 To results.Count
                For j = 1 To 3
                    With wsDestination.Cells(nextRow + i - 1, j)
                        .Value = results(i)(j - 1)
                        .Interior.Color = colors(i)
                    End With
                Next j
            Next i
        End If
    Next prefix
End Sub
 

Chounoé

XLDnaute Nouveau
Non je n'ai pas l'utilité d'en faire 3, je veux juste qu'au lieu qu'elle me marque en détail tout ce qu'il y a en CB- qu'elle généralise en une fois.

Car si par exemple je viens a rajouter une ligne commençant par CB-45 la macro ne tiendra pas compte de ce nouveau nom vu qu'elle s'arrête jusqu'à CB-35. Je ne sais pas si tu vois ce que je veux dire
 

Franc58

XLDnaute Occasionnel
Non je n'ai pas l'utilité d'en faire 3, je veux juste qu'au lieu qu'elle me marque en détail tout ce qu'il y a en CB- qu'elle généralise en une fois.

Car si par exemple je viens a rajouter une ligne commençant par CB-45 la macro ne tiendra pas compte de ce nouveau nom vu qu'elle s'arrête jusqu'à CB-35. Je ne sais pas si tu vois ce que je veux dire
Tu as testé ma macro ?
 

Discussions similaires

Statistiques des forums

Discussions
312 534
Messages
2 089 383
Membres
104 152
dernier inscrit
sabalex