Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Comparaison donnée Excel


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Comparaison donnée Excel
    Bonjour la communauté,

    Je sollicite votre aide afin de remplir un tableau en fonction d'un autre fichier en effet j'ai un premier fichier Liste_Source_fruit_test.xlsx qui correspond aux données sources avec des niveau 2, 3 et 4 qui correspondent respectivement au pays, mois et container avec une troisième colonne ou il y a des produit("fruits") et un deuxième fichier nommé Dash_Fruit.xlsm avec une colonne A pays et une ligne mois avec les fruits en dessous. je souhaite remplir mon deuxième fichier de façon a ce que quand les pays, les mois et fruits correspondent sur les deux fichiers-> mettre une case OK dans la bonne cellule avec un bouton : ouverture du fichier Liste_Source_fruit_test.xlsx(réalisé) , lecture et comparaison.
    Merci pour votre aide.

    Cordialement;

  2. #2
    Membre expert
    Bonjour,

    J'ai modifié la structure du classeur "Liste_source_des_fruits" de manière à le rendre plus lisible et plus fonctionnel


    D'ailleurs pourquoi créer un deuxième classeur comme base de données, cette BDD dans une autre feuille du classeur "Dash_Fruit" eut été plus simple et aurait évité l'ouverture de ce deuxième classeur.

    le fichier "Dash_Fruit"


    Dans le module de la feuille
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Private Sub CommandButton1_Click()
        Dim Fichier, NomFichier$
        Application.ScreenUpdating = False
        Fichier = Application.GetOpenFilename("Fichiers Microsoft Office Excel, *.xlsx")
        If Fichier = False Then Exit Sub
        If Fichier Like "*\" & ThisWorkbook.Name Then MsgBox "Ouverture non autorisée.": Exit Sub
        On Error Resume Next
        Workbooks.Open Fichier
        On Error GoTo 0
        NomFichier = Dir(Fichier)
        Workbooks(NomFichier).Activate
        Remplissage
    End Sub



    Dans un module standard
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
     
    Sub Remplissage()
        Dim f1 As Worksheet, f2 As Worksheet
        Dim i As Long, j As Long, l As Long, k As Long, c As Long
        Dim p As Object, m As Object
        Application.ScreenUpdating = False
        Windows("Liste_Source_fruit.xlsx").Activate
        Set f1 = Sheets("Liste_source_des_fruits")
        Set f2 = Sheets("Liste_des_pays")
        DerLig_Pays = f2.Range("A" & Rows.Count).End(xlUp).Row
        DerLig_Site = f1.Range("A" & Rows.Count).End(xlUp).Row
        ReDim Mois(DerLig_Site) As String
        ReDim Fruit(DerLig_Site) As String
        For i = 2 To DerLig_Pays
            Pays = f2.Cells(i, "A")
            NbFruits = 0
            For j = 2 To DerLig_Site
                l = j
                Do While f1.Cells(l, "A") = Pays
                    If f1.Cells(l, "D") <> "" Then
                        Mois(l - 1) = f1.Cells(l, "B")
                        Fruit(l - 1) = f1.Cells(l, "D")
                    End If
                    l = l + 1
                Loop
            Next j
     
            'recopie dans fichier "Dash_fruit"
            l = l - 1
            Windows("Dash_Fruit.xlsm").Activate
            Set p = Columns(1).Find(Pays)
            For k = 1 To l
                If Mois(k) <> "" Then
                    Set m = Rows(1).Find(Mois(k))
                    c = m.Column
                    If Not m Is Nothing Then
                       Do While Cells(2, c) <> Fruit(k)
                            c = c + 1
                        Loop
                        Cells(p.Row, c) = "Ok"
                        Mois(k) = ""
                        Fruit(k) = ""
                    End If
                End If
            Next k
            Windows("Liste_Source_fruit.xlsx").Activate
        Next i
        Windows("Dash_Fruit.xlsm").Activate
        Set m = Nothing
        Set p = Nothing
        Set f1 = Nothing
        Set f2 = Nothing
    End Sub


    Cdlt

  3. #3
    Membre à l'essai
    Bonjour,

    Merci pour ta réponse c'est excatement ce que je voulais avoir comme résultat, je me permets de pousser un peu le sujet en effet au lieu d'avoir un simple Ok j'aimerai avoir un Ok avec l'occurrence du fruit qui s'y trouve au bon mois et en provenance du bon pays. j'ai essayé avec ce code mais ca ne fonctionne pas vu que je suis un grand nul en vba ca ne m'étonne pas. Merci par avance de ton aide précieuse

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    Sub Remplissage()
        Dim f1 As Worksheet, f2 As Worksheet
        Dim i As Long, j As Long, l As Long, k As Long, C As Long
        Dim p As Object, m As Object, y As Object
        Application.ScreenUpdating = False
        Windows("Liste_Source_fruit.xlsx").Activate
        Set f1 = Sheets("Liste_source_des_fruits")
        Set f2 = Sheets("Liste_des_pays")
        DerLig_Pays = f2.Range("A" & Rows.Count).End(xlUp).Row
        DerLig_Site = f1.Range("A" & Rows.Count).End(xlUp).Row
        ReDim Mois(DerLig_Site) As String
        ReDim Fruit(DerLig_Site) As String
     
     
        For i = 2 To DerLig_Pays
            Pays = f2.Cells(i, "A")
            NbFruits = 0
            For j = 2 To DerLig_Site
                l = j
                Do While f1.Cells(l, "A") = Pays
                    If f1.Cells(l, "D") <> "" Then
                        Mois(l - 1) = f1.Cells(l, "B")
                        Fruit(l - 1) = f1.Cells(l, "D")
                    End If
                    l = l + 1
                Loop
            Next j
     
    '            Dim NbOccurrence As Long
    '    Dim V As Object
    '    Dim NbOcur As Long
    '    Dim FirstAdresse As String
    '
    '    'NbOcur = 0
    '    With Plage
    '        Set V = f1.Range("D2<img src="images/smilies/icon_biggrin.gif" border="0" alt="" title=":D" class="inlineimg" />102").Find(Fruit, LookIn:=xlValues)
    '        If Not V Is Nothing Then
    '            FirstAdresse = V.Address()
    '            Do
    '                NbOcur = NbOcur + 1
    '                'Set V = f1.Range("D2<img src="images/smilies/icon_biggrin.gif" border="0" alt="" title=":D" class="inlineimg" />102").FindNext(V)
    '            Loop While Not V Is Nothing And V.Address <> FirstAdresse
    '        End If
    '    End With
    '
    '    NbOccurrence = NbOcur
    Dim Nb_OK As Long
     
     
     
     
            'recopie dans fichier "Dash_fruit"
            l = l - 1
            Windows("Dash_Fruit.xlsm").Activate
            Set p = Columns(1).Find(Pays)
            For k = 1 To l
                If Mois(k) <> "" Then
                    Set m = Rows(1).Find(Mois(k))
                    C = m.Column
                        Set y = Columns(4).Find(Fruit)
                        Nb_OK = y.Column
                        MsgBox Nb_OK
                    If Not m Is Nothing Then
                       Do While Cells(2, C) <> Fruit(k)
                            C = C + 1
                            Nb_OK = Nb_OK + 1
                        Loop
                        Cells(p.Row, C) = "Ok" & "(" & Nb_OK & ")"
                        Mois(k) = ""
                        Fruit(k) = ""
                    End If
                End If
            Next k
            Windows("Liste_Source_fruit.xlsx").Activate
        Next i
        Windows("Dash_Fruit.xlsm").Activate
        Set m = Nothing
        Set p = Nothing
        Set f1 = Nothing
        Set f2 = Nothing
    End Sub

  4. #4
    Membre expert
    Bonjour,

    Le fichier "Dash_Fruit"


    le code
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    Sub Remplissage()
        Dim f1 As Worksheet, f2 As Worksheet
        Dim i As Long, j As Long, l As Long, k As Long, c As Long, Col As Long
        Dim p As Object, m As Object
        Application.ScreenUpdating = False
        Windows("Liste_Source_fruit.xlsx").Activate
        Set f1 = Sheets("Liste_source_des_fruits")
        Set f2 = Sheets("Liste_des_pays")
        DerLig_Pays = f2.Range("A" & Rows.Count).End(xlUp).Row
        DerLig_Site = f1.Range("A" & Rows.Count).End(xlUp).Row
        ReDim Mois(DerLig_Site) As String
        ReDim Fruit(DerLig_Site) As String
        For i = 2 To DerLig_Pays
            Pays = f2.Cells(i, "A")
            For j = 2 To DerLig_Site
                l = j
                Do While f1.Cells(l, "A") = Pays
                    If f1.Cells(l, "D") <> "" Then
                        Mois(l - 1) = f1.Cells(l, "B")
                        Fruit(l - 1) = f1.Cells(l, "D")
                    End If
                    l = l + 1
                Loop
            Next j
     
            'recopie dans fichier "Dash_fruit"
            l = l - 1
            Windows("Dash_Fruit.xlsm").Activate
            DerCol_f1 = Range("D2").End(xlToRight).Column 'Dernière colonne du tableau
            Set p = Columns(1).Find(Pays)
            Range(Cells(p.Row, "D"), Cells(p.Row, DerCol_f1)).ClearContents 'effacement des précédents relevés
            For k = 1 To l
                If Mois(k) <> "" Then
                    Set m = Rows(1).Find(Mois(k))
                    c = m.Column
                    If Not m Is Nothing Then
                       Do While Cells(2, c) <> Fruit(k)
                            c = c + 1
                        Loop
                        Cells(p.Row, c) = Cells(p.Row, c) + 1
                        Mois(k) = ""
                        Fruit(k) = ""
                    End If
                End If
            Next k
            For Col = 4 To DerCol_f1
                If Cells(p.Row, Col) <> "" Then Cells(p.Row, Col).Value = "Ok" & Chr(10) & Cells(p.Row, Col).Value
            Next Col
            Windows("Liste_Source_fruit.xlsx").Activate
        Next i
     
        Windows("Dash_Fruit.xlsm").Activate
        Set m = Nothing
        Set p = Nothing
        Set f1 = Nothing
        Set f2 = Nothing
    End Sub


    Cdlt

  5. #5
    Membre à l'essai
    Bonjour,

    Merci, c'est le résultat attendu Bon Week End.