XL 2019 Macro comparer colonne d'un fichier avec la colonne d'un fichier fermé et chercher similitude

[laktats]

Bonjour je bloque sur cet exercice svp! si qq peut m'aider..
je dispose de deux fichiers : SuiviCND et Aspirateur.
Dans chacun de ces 2 fichiers j'ai deux tableaux :
-Tableau 1 dans Aspirateur : j'ai une colonne "CHILD PRODUCT"
-Tableau 2 dans SuiviCND : j'ai une colonne "CODE ARTICLE"
J'aimerais etablir une macro qui va comparer la colonne "CHILD PRODUCT" (Tableau1) du fichier Aspirateur avec la colonne "CODE ARTICLE" (Tableau2) du fichier SuiviCND.
Si la macro trouve des numéros identiques entre child product et code article, elle doit se situer sur les lignes où on a trouvé les similitudes dans le tableau2 SuiviCND, puis lire la cellule de le colonne historique CND ensuite je compléterais la fin ^^.
C'est un bout de code pour terminer mon projet qui me manque !
Merci bcp pour votre aide.

 

[tomocam]

Bonsoir Laktats,

Avec 1 bon mois de décalage, ci-dessous un bout de code qui peut aider

Sub Macro1()

Dim a As String
wb_waat = ActiveWorkbook.Name

MsgBox ("sélectionnez le fichier SuiviCND")
dialogopen = Application.Dialogs(xlDialogOpen).Show(ActiveWorkbook.Path, False)
If dialogopen = False Then
    Exit Sub
End If
wb_CND = ActiveWorkbook.Name

r = 2

Do While Workbooks(wb_waat).Sheets("Sheet1").Cells(r, 5).Value <> ""
On Error Resume Next

    a = Right(Left(Workbooks(wb_waat).Sheets("Sheet1").Range("E" & r).Value, Len(Workbooks(wb_waat).Sheets("Sheet1").Range("E" & r).Value) - (Len(Workbooks(wb_waat).Sheets("Sheet1").Range("E" & r).Value) - InStr(1, Workbooks(wb_waat).Sheets("Sheet1").Range("E" & r).Value, "\") + 1)), 6)
    check = Workbooks(wb_CND).Sheets("Suivi_CND").Columns(6).Find(what:=a, lookat:=xlWhole).Row
    
        If check = "" Then
        check = Nothing
        r = r + 1
        Else
        historique = Workbooks(wb_CND).Sheets("Suivi_CND").Range("M" & check).Value
        'ajouter ici le code voulu sur la case historique
        
        check = Nothing
        r = r + 1
        End If
Loop

End Sub

Tomo

 

[laktats]

Bonjour, merci de votre réponse tout de meme, c'est très sympa, j'aurais une derière petite question svp ^^
Je vous mets mon code complet , je cherche d'abord si un fichier existe en s'aidant des colonnes child op/child product comme nom de fichier. Si le fichier existe je met lien hypertexte dans mes cells du tableau, cela fonctionne !
Mtn, si le fichier est pas trouvé, on doit chercher dans le fichier suiviCND si on a un N°Série(Fichier Aspirateur)=N°Code article(Fichier SuiviCND10ème colonne) en parcourant les colonnes entières. Si on a une égalité, il faut lire 15ème colonne du fichier SuiviCND et renvoyer le contenu de cette dernière cellule dans mon tableau fichier aspirateur.
C'est sur cette deuxième partie que je bloque depuis des mois ...
merci beaucoup pour le temps accordé.

Sub Aspi1()

'Déclaration variables Objects parcours de répertoire
Dim Fso As Scripting.FileSystemObject, Rep As String
Dim f1 As Object, f2 As Object
Dim OF As String
Dim Produit As Variant
Dim SE As Variant
Dim NomIcomplet As String
Dim i As Long
Dim src As Workbook


Set src = Workbooks.Open("C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND\01 - Modèle\SuiviCND.xlsm", True, True)
ThisWorkbook.Activate

i = 2
Do While Cells(i, 4) <> "" ' compteur de ligne colonne CHILD OP/PRODUCT
    OF = Cells(i, 4) 'CHILD OP
    Produit = Mid(Cells(i, 5), 8, 6) 'CHILD PRODUCT
    SE = Right(Cells(i, 5), Len(Cells(i, 5)) - 14) 'S/N
    Rep = "C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND" & "\" 'Définit le répertoire contenant les fichiers
    Set Fso = CreateObject("Scripting.FileSystemObject")
    For j = 7 To 10 'compteur colonne VT/PT/MT/UT "Aspirateur"
        Cells(i, j) = ""
        TEST = Cells(1, j)
        NomIncomplet = OF & "-" & TEST & "-" & Produit & "-" & SE & "-"
        For Each f1 In Fso.GetFolder(Rep).SubFolders    ' Dans le dossier
            For Each f2 In f1.Files 'et chaque sous dossiers
                If f2.Name Like "*" & NomIncomplet & "*" = True Then  ' Si le fichier cherché egal au N°OF
                    Set MonApp = CreateObject("Shell.Application")
                    Chemin = Rep & f2.Name
                    Cells(i, j) = f2.Name
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, j), _
                    Address:=f2.ParentFolder & "\" & f2.Name
                    MonApp.Open (Chemin)
                    Set MonApplication = Nothing
                    Present = 1
                    GoTo 10:
                
                Else

                    FinCol = src.Sheets("Suivi_CND").Range("F65536").End(xlUp).Row 'dernière ligne N°CodeArticle
                    For L = 2 To FinCol
                        Set PlageCodeArticle = src.Sheets("Suivi_CND").Cells(L, 6) 'colonne N°codearticle
                        Set Trouve = PlageCodeArticle.Cells.Find(what:=Produit, LookAt:=xlWhole)
            
                        If Trouve Is Nothing Then 'Si Produit différent de Code article
                            Cells(i, j) = "Erreur N°produit"
                            GoTo 10:
                        Else 'Si Produit=CodeArticle
                            For Each Produit In PlageCodeArticle
                                FinCol1 = src.Sheets("Suivi_CND").Range("J65536").End(xlUp).Row 'dernière ligne N°Série
                                For K = 2 To FinCol1
                                    Set PlageSerie = src.Sheets("Suivi_CND").Cells(K, 10) 'colonne N°Serie
                                    Set Trouve1 = PlageSerie.Cells.Find(what:=SE, LookAt:=xlWhole)
                                    
                                    If Trouve1 Is Nothing Then 'Si SE différent de Série
                                        Cells(i, j) = "Erreur N°Série"
                                    Else 'Si SE=Serie
                                        For Each SE In PlageSerie
                                            HistCND = src.Sheets("Suivi_CND").Cells(K, 15)
                                            If HistCND = "N/A" Then
                                                    Cells(i, j) = "N/A"
                                            Else
                                                    Cells(i, j) = "FAIT"
                                            End If
                                        Next SE
                                    End If
                                Next K
                            Next Produit
                        End If
                   Next L
                End If
            Next f2
        Next f1
10:
    Next j
i = i + 1
Loop
src.Close False
Set src = Nothing
End Sub

 

[tomocam]

Bonjour,

reprenez le code que je vous ai indiqué mais en le doublant:

pour ça chaque ligne du fichier aspirateur, faites une boucle sur le fichier suivi CND pour vérifier l’égalité.
Si c’est le cas, copier la colonne 15 en utilisant une formule du type :
Workbooks(suiviCND).sheets(Feuil1).cells(r,x).value = workbooks(aspirateur).sheets(Feuil1).cells(a,y)

tomo

 

[laktats]

salut, merci beaucoup pour l'astuce j'y travaille, j'ai une question !
comment dire a macro d'aller lire la cellule de la 15ème colonne du fichier SuiviCND qui se trouve dans la meme ligne ou on a trouver un produit = code article ? faut il utilisé les coordonnées de la cellule ? mais comment exprimer les coordonnes de la cellule où l'on a trouvé la similitude ?
Merci beaucoup pour votre aide j'ai pu bien avancer ^^

 

[tomocam]

Bonsoir,

oui il faut utiiiser les coordonnées de la cellule.
Celle où l’on a trouvé la correspondance à un numéro de ligne (r dans mon code).
Il suffit de lire la valeur de la cellule sur la même ligne avec une colonne différente soit:

cells(r,15).value

 

[laktats]

MERCI BCPP c'est super logique oui ^^ bonne soirée !!