Extraction de données complexe

[Duracell]

Bonjour,

J’ai besoin d’extraire des données de plusieurs feuilles Excel et plusieurs colonnes de la manière suivante :
Situation. Je vernis des produits. Ces produits peuvent être vernis lors de plusieurs étapes correspondant à chaque feuille Excel. Ces produits peuvent être vernis plusieurs fois chacun. Mon but est de regrouper les vernis utilisés par produit dans un nombre de colonne égale au nombre de vernis. C'est-à-dire que si pour un produit, il y a déjà un vernis dans la première colonne, le second s’intègre dans la deuxième colonne… Quand il n’y a pas de vernis, rien ne doit-être écrit. Si un produit a deux vernis identique, le vernis n'est marqué qu'une fois.😕

Ci-joint un fichier exemple en imaginant que j’ai 16000 produits et beaucoup de poste où peuvent être vernis les produits.

Pouvez-vous m’aider ?

Merci

 

[CISCO]

Re : Extraction de données complexe

Bonjour

Pour que nous soyons plus efficaces, cela sera bien si tu mettais dans ton fichier une feuille avec les résultats attendus.

@ plus

 

[Duracell]

Re : Extraction de données complexe

Ci-joint un fichier plus court avec le résultat voulu en premier onglet.
Merci.

 

[mromain]

Re : Extraction de données complexe

bonjour Duracell, CISCO,

je te propose ce code (à adapter) :

[B]Public Const noMaxFeuille As Integer = 2[/B]


Sub test()
Dim noFeuille As Integer, ligneItem As Integer, ligneItemRecherche As Integer
Dim memAdresse As String
Dim cellRecherche As Range
Dim feuilleResultat As Worksheet

    Set feuilleResultat = ThisWorkbook.Sheets("résultat")
    For ligneItem = 2 To feuilleResultat.Range("A" & feuilleResultat.Rows.Count).End(xlUp).Row
        For noFeuille = 1 To noMaxFeuille
            With ThisWorkbook.Sheets("vernis poste " & CStr(noFeuille))
                Set cellRecherche = .Columns("A").Find(feuilleResultat.Range("A" & ligneItem), , xlValues, xlWhole)
                If Not cellRecherche Is Nothing Then
                    ligneItemRecherche = cellRecherche.Row
                    Set cellRecherche = .Rows(1).Find("vernis", , xlValues, xlPart, , False)
                    If Not cellRecherche Is Nothing Then
                        memAdresse = cellRecherche.Address
                        Do
                            feuilleResultat.Cells(ligneItem, feuilleResultat.Columns.Count).End(xlToLeft).Offset(0, 1).Value = .Cells(ligneItemRecherche, cellRecherche.Column).Text
                            Set cellRecherche = .Rows(1).FindNext(cellRecherche)
                        Loop Until cellRecherche.Address = memAdresse
                    End If
                End If
            End With
        Next
    Next ligneItem
End Sub

ici, noMaxFeuille = 2, car les onglets "vernis poste X" ne vont que jusqu'à 2

a+

 

[Duracell]

Re : Extraction de données complexe

Merci mromain,
Ca correspond à mon besoin mais c'est un exemple simple. Mes feuilles ont des nom différents chacune (CC COLLE; ENDUCTION VERNIS; bon CCR + PERFO; CC CIRE; ENDUCTION CIRE). Et les colonnes ont aussi d'autre nom. Comment je fais pour changer ça dans cette formule?

Merci

 

[mromain]

Re : Extraction de données complexe

bonjour Duracell, le fil,

un autrre essai à adapter :

Sub test()
Dim noFeuille As Integer, ligneItem As Integer, ligneItemRecherche As Integer
Dim memAdresse As String
Dim cellRecherche As Range
Dim feuilleResultat As Worksheet[COLOR=Red][B], curSheet As Worksheet[/B][/COLOR]

    Set feuilleResultat = ThisWorkbook.Sheets("résultat")
    For ligneItem = 2 To feuilleResultat.Range("A" & feuilleResultat.Rows.Count).End(xlUp).Row
        [COLOR=Red][B]For Each curSheet In ThisWorkbook.Sheets(Array("CC COLLE", "ENDUCTION VERNIS", "bon CCR + PERFO", "CC CIRE", "ENDUCTION CIRE"))[/B][/COLOR]
            With curSheet
                Set cellRecherche = .Columns("A").Find(feuilleResultat.Range("A" & ligneItem), , xlValues, xlWhole)
                If Not cellRecherche Is Nothing Then
                    ligneItemRecherche = cellRecherche.Row
                    Set cellRecherche = .Rows(1).Find("vernis", , xlValues, xlPart, , False)
                    If Not cellRecherche Is Nothing Then
                        memAdresse = cellRecherche.Address
                        Do
                            feuilleResultat.Cells(ligneItem, feuilleResultat.Columns.Count).End(xlToLeft).Offset(0, 1).Value = .Cells(ligneItemRecherche, cellRecherche.Column).Text
                            Set cellRecherche = .Rows(1).FindNext(cellRecherche)
                        Loop Until cellRecherche.Address = memAdresse
                    End If
                End If
            End With
        [B][COLOR=Red]Next curSheet[/COLOR][/B]
    Next ligneItem
End Sub

a+

 

[Duracell]

Re : Extraction de données complexe

Merci beaucoup mromain.
C'est très sympas d'avoir répondu à mes questions.
Ca fonctionne très bien.

Merci et a+