Discussion :

[Lison Lisette]

Bonjour,

J`ai une base de données (feuille1) et des nouvelles informations (feuille2).

Je souhaiterais comparer ce que j`ai dans ma nouvelle feuille par rapport à ce qui est déja présent dans la base de données.

Ce qui est commun à la feuille 1 et 2, je souhaite le supprimer dans la feuille 2 (comme ca j`en ferais une copie par la suite de ce aui est nouveau seulement dans la feuille 2 pour alimenter la feuille 1 = ma base de données...

Je vous mets le fichier joint, ma macro pour le moment ressemble à ca :

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
Option Base 1
Sub compare()
Dim i As Long, j As Long, tabF1 As Variant, tabF2 As Variant, egal As Boolean
tabF1 = Sheets("Feuil1").Range("A1").CurrentRegion
tabF2 = Sheets("Feuil2").Range("A1").CurrentRegion
With Sheets("Feuil2")
For i = UBound(tabF1) To 2 Step -1
egal = True
    For j = UBound(tabF1, 2) To 1 Step -1
    If tabF1(i, j) <> tabF2(i, j) Then egal = False
    Next j
If egal Then .Cells(i, 1).EntireRow.Delete
Next i
End With
Sheets("Feuil2").Select
End Sub

Mais ne marche pas du tout (notamment à cause du current region et des cases vides à mon avis... Mais ca fait un bon moment que je cherche et je nàrrive pas à débloquer la situation... So Help !!!!

L.

[mercatog]

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
Sub compare()
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
LastLig1 = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Feuil2")
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = LastLig2 To 1 Step -1
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig1).Find(.Range("A" & i).Value, lookat:=xlWhole)
        If Not c Is Nothing Then
            .Rows(i).Delete
            LastLig2 = LastLig2 - 1
            Set c = Nothing
        End If
    Next i
    If LastLig2 > 0 Then .Range("A1:L" & LastLig2).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
End With
End Sub

[Lison Lisette]

Mercatog, tu es d`une efficacité redoutable ! Merci, cela fonctionne à merveille....

Je me rends compte cependant que mon système présente un gros problème :

si une modification est faite sur une ligne "AB12345", le "AB12345" complet qui est un seul et même composant (décomposé en 6 lignes) doit faire l`objet d`un examen plus approfondi, même si des lignes restent similaires...

Dans mon cas, cela va copier juste la ligne modifiée dans la base de donnée...

Je n`ai pour le moment pas de possibilité d`avoir un logiciel de base de donnée relationnelle, n`y a-t-il pas un moyen de "tricher" pour obtenir quelque-chose qui ressemble à ca :

J`ai un paquet de 6 "AB12345" correspondant en réalité à un seul composant

- Si "AB12345" n`existe pas dans la base de donnée, rajouter toutes les lignes "AB12345" à la suite de la base de donnée (donc ici les 6 lignes)

- si AB12345 existe dans la base de donnée, deux possibilités :

- si TOUTES les lignes ayant le même identifiant (ex: 6 lignes AB12345) sont EXACTEMENT égales au "paquet AB123452" de la base de donnée (les lignes sont bien 6, pas plus pas mois, et identiques une à une), les copier dans la base de donnée et les supprimer de la feuille 2

- si seulement UNE PARTIE des lignes "AB12345" est égale aux lignes "AB12345" déjà présentes dans la base de donnée, mettre en rouge dans la feuille 2 (par exemple pas le même nombre de lignes ou différences sur certaines lignes)

Je ne sais pas si tu peux trouver une solution à ca... moi malheureusement je n`ai aucune idée de comment traiter des *"paquets" de données ayant un point commun, pour les comparer entre elles... pense tu à une façon astucieuse procéder ? C`est possible avec des macros?

[mercatog]

Tes paquets commencent toujours par LF en colonne B?
Enfin de compte, tu veux faire une mise à jour de ta base de donnée
si un paquet n'existe pas, tu le rajoute
si il existe, tu remplace les anciennes valeurs par les nouvelles.
C'est ça?

[Lison Lisette]

Ah non, LF correspond à une modification de la pièce, mais une pièce sans modification peut avoir la colonne B complètement vide, ou une autre modification avec un autre nom
...
Par contre dans la colonne C il y a forcément une description de cette pièce.
Ça peut être le repère pour savoir si tu change de "paquet" donc de pièce...

si un paquet n'existe pas, tu le rajoute OK

si il existe, DEUX POSSIBILITEES :

1) Strictement identique = on touche à rien, mais on peut mettre le paquet en vert par exemple dans la feuille 2 pour savoir ce qui à été laissé

2) PAS strictement identique (des lignes différentes OU pas le même nombre de lignes) = le mettre en rouge dans la feuille 2 (pour comparer manuellement et voir quelle version on garde par la suite)

C`est faisable ? Ce serait EXTRA !!!

[mercatog]

Je ne supprime aucune ligne
dans feuil2:
Lignes jaunes: lignes ajoutées à feuil1
Lignes vertes: lignes identiques
Lignes rouges; Lignes différentes

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 Compare()
Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim k As Byte
Dim c As Range, v As Range, w As Range
Dim Data1 As String, Data2 As String
 
Application.ScreenUpdating = False
With Sheets("Feuil2")
    .AutoFilterMode = False
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To LastLig2
        On Error Resume Next
        Kol.Add .Range("A" & i).Value, .Range("A" & i).Value
        On Error GoTo 0
    Next i
    For i = 1 To Kol.Count
        With Sheets("Feuil1")
            .AutoFilterMode = False
            LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row
        End With
        .Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig1).Find(Kol(i), lookat:=xlWhole)
        If Not c Is Nothing Then
            Sheets("Feuil1").Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)
            For Each v In .Range("A2:A" & LastLig2).SpecialCells(xlCellTypeVisible)
                Data1 = vbNullString
                For k = 1 To 12
                    Data1 = Data1 & "_" & .Cells(v.Row, k)
                Next k
                For Each w In Sheets("Feuil1").Range("A2:A" & LastLig1).SpecialCells(xlCellTypeVisible)
                    Data2 = vbNullString
                    For k = 1 To 12
                        Data2 = Data2 & "_" & Sheets("Feuil1").Cells(w.Row, k)
                    Next k
                    If Data1 = Data2 Then
                        .Range("A" & v.Row & ":L" & v.Row).Interior.ColorIndex = 4
                        Exit For
                    Else
                        .Range("A" & v.Row & ":L" & v.Row).Interior.ColorIndex = 3
                    End If
                Next w
            Next v
            Set c = Nothing
        Else
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
        End If
    Next i
    .AutoFilterMode = False
End With
Sheets("Feuil1").AutoFilterMode = False
End Sub

[Lison Lisette]

Et bien, c'est PRESQUE ca, mais avec un raisonnement par *«paquet» et non par ligne...

Je m'explique, considérons AB12345 notre composant comme étant des «pates carbonara» et les composés chimiques par «oeuf, crème, pâtes spaghetti, sel, poivre»

On a donc

ligne 1 AB12345 pâtes carbo oeuf
ligne 2 AB12345 ................ crème
ligne 3 AB12345 ................ PATES SPAGHETTI
ligne 4 AB12345 ............... sel
ligne 5 AB12345 ................ poivre

dans la base de donnée...

... et dans le formulaire j'ai :

ligne 1 AB12345 pâtes carbo oeuf
ligne 2 AB12345 ................ crème
ligne 3 AB12345 ................ HARICOTS
ligne 4 AB12345 ............... sel
ligne 5 AB12345 ............... poivre

(les petits points représentent des cellules vides, il y a un numéro de ligne et 3 colonnes dans cet exemple)

J'aimerais que le programme cherche si ce composé AB12345 est dans la base. Dans ce cas OUI, il y est... (si il ny était pas il faudrait rajouter les lignes 1 2 3 4 et 5 à la base et colorier ces mêmes lignes en jaune dans le formulaire, pour savoir que ca a été rajouté)

AB12345 est dans la base MAIS ce n'est pas le même car un composant a changé (haricot). (si ca avais été le même, il faudrait juste le mettre en vert dans le formulaire pour savoir qu'il ets déjà dans la base, et rien faire d'autre)

NOTRE CAS ICI ; Il est dans la base MAIS, ce n'est pas le même.. Il ne faut donc pas le copier mais le mettre en évidence (rouge par exemple) comme ca en vérifiant, on peut choisir quelle est la version qu'on garde..

Je ne sais pas si ma problématique est claire...
Je ne peux pas raisonner par lignes car dans ce cas, la macro va me rajouter la ligne «HARICOTS» dans la base, ce qui est une erreur, la recette sera fausse...

[mercatog]

C'est ce que le code fait...
en principe

[Lison Lisette]

En effet !!!!!!!!!
J'avais mal exécuté.

Décidément tu es incollable

je vais tâcher de comprendre point par point ce que tu as fait maintenant, ca devrait m'occuper une bonne demie journée !!!!

MERCI !

[mercatog]

Pour l'aide, du commentaire

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
Sub Compare()
Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim k As Byte
Dim c As Range, v As Range, w As Range
Dim Data1 As String, Data2 As String
 
Application.ScreenUpdating = False
With Sheets("Feuil2")
    .AutoFilterMode = False                                         'Enlève le filtre automatique de feuil2
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row                  'Dernière ligne remplie de feuil2
    '-----------------------------------------------------------------
    For i = 2 To LastLig2
        On Error Resume Next
        Kol.Add .Range("A" & i).Value, .Range("A" & i).Value        'Ici on crée une collection des id de feuil2 (sans doublons par construction)
        On Error GoTo 0
    Next i
    '------------------------------------------------------------------
    For i = 1 To Kol.Count                                          'On parcourt chaque élément de la collection des id
        With Sheets("Feuil1")
            .AutoFilterMode = False                                 'Enlève le filtre automatique de feuil1
            LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row          'Dernière ligne remplie de feuil1
        End With
        .Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)         'On filtre feuil2 sur chaque élément de la collection des id
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig1).Find(Kol(i), lookat:=xlWhole) 'On cherche si cet élément existe en feuil1
        If Not c Is Nothing Then                                                        'Si l'id existe en feuil1
            Sheets("Feuil1").Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)         'On filtre aussi feuil1 sur cet id
            For Each v In .Range("A2:A" & LastLig2).SpecialCells(xlCellTypeVisible)     'on parcourt toutes les lignes visibles de feuil2 (résultat du filtre)
                Data2 = vbNullString
                For k = 1 To 12
                    Data2 = Data2 & "_" & .Cells(v.Row, k)                              'On concatène les valeurs des cellules de A à L (pour chaque ligne de la plage filtée de feuil2)
                Next k
                For Each w In Sheets("Feuil1").Range("A2:A" & LastLig1).SpecialCells(xlCellTypeVisible) 'on parcourt toutes les lignes visibles de feuil1 (résultat du filtre)
                    Data1 = vbNullString
                    For k = 1 To 12
                        Data1 = Data1 & "_" & Sheets("Feuil1").Cells(w.Row, k)                          'On concatène les valeurs des cellules de A à L (pour chaque ligne de la plage filtée de feuil1)
                    Next k
                    If Data1 = Data2 Then                                                               'Si la ligne de feuil2 est identique à l'une des lignes de feuil1
                        .Range("A" & v.Row & ":L" & v.Row).Interior.ColorIndex = 4                      'On colorie en vert et on sort de la boucle de recherche sur feuil1
                        Exit For
                    Else                                                                                'Sinon, on colorie en rouge (peut être il faut passer par une valeur booléan mais bon, ça sera pour l'optimisation du code
                        .Range("A" & v.Row & ":L" & v.Row).Interior.ColorIndex = 3
                    End If
                Next w
            Next v
            Set c = Nothing
        Else                                                                                        'Si l'id de feuil2 n'existe pas dans feuil1
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6       'On colorie la plage filtrée en feuil2 en jaune et on la copie en fin de feuil1
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
        End If
    Next i
    .AutoFilterMode = False
End With                                                                        'on enlève les filtres auto des 2 feuilles
Sheets("Feuil1").AutoFilterMode = False
End Sub

[Lison Lisette]

Super gentil ca, merciiiiii

[mercatog]

Une version légèrement simplifiée

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
Sub Compare()
Dim Kol As New Collection
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim k As Byte, Exact As Byte
Dim c As Range, v As Range, w As Range
Dim Data1 As String, Data2 As String
 
Application.ScreenUpdating = False
With Sheets("Feuil2")
    .AutoFilterMode = False                                         'Enlève le filtre automatique de feuil2
    LastLig2 = .Cells(Rows.Count, 1).End(xlUp).Row                  'Dernière ligne remplie de feuil2
    '-----------------------------------------------------------------
    For i = 2 To LastLig2
        On Error Resume Next
        Kol.Add .Range("A" & i).Value, .Range("A" & i).Value        'Ici on crée une collection des id de feuil2 (sans doublons par construction)
        On Error GoTo 0
    Next i
    '------------------------------------------------------------------
    For i = 1 To Kol.Count                                          'On parcourt chaque élément de la collection des id
        With Sheets("Feuil1")
            .AutoFilterMode = False                                 'Enlève le filtre automatique de feuil1
            LastLig1 = .Cells(Rows.Count, 1).End(xlUp).Row          'Dernière ligne remplie de feuil1
        End With
        .Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)         'On filtre feuil2 sur chaque élément de la collection des id
        Set c = Sheets("Feuil1").Range("A1:A" & LastLig1).Find(Kol(i), lookat:=xlWhole)    'On cherche si cet élément existe en feuil1
        If Not c Is Nothing Then                                                        'Si l'id existe en feuil1
            Sheets("Feuil1").Range("A1").AutoFilter field:=1, Criteria1:=Kol(i)         'On filtre aussi feuil1 sur cet id
            For Each v In .Range("A2:A" & LastLig2).SpecialCells(xlCellTypeVisible)     'on parcourt toutes les lignes visibles de feuil2 (résultat du filtre)
                Data2 = vbNullString
                For k = 1 To 12
                    Data2 = Data2 & "_" & .Cells(v.Row, k)                              'On concatène les valeurs des cellules de A à L (pour chaque ligne de la plage filtée de feuil2)
                Next k
                For Each w In Sheets("Feuil1").Range("A2:A" & LastLig1).SpecialCells(xlCellTypeVisible)    'on parcourt toutes les lignes visibles de feuil1 (résultat du filtre)
                    Data1 = vbNullString
                    For k = 1 To 12
                        Data1 = Data1 & "_" & Sheets("Feuil1").Cells(w.Row, k)                          'On concatène les valeurs des cellules de A à L (pour chaque ligne de la plage filtée de feuil1)
                    Next k
                    If Data1 = Data2 Then                                                               'Si la ligne de feuil2 est identique à l'une des lignes de feuil1
                        Exact = 1                    'On sort de la boucle de recherche sur feuil1 et on affecte à Exact la valeur 1
                        Exit For
                    End If                                                                              'Sinon, on colorie en rouge (peut être il faut passer par une valeur booléan mais bon, ça sera pour l'optimisation du code
                Next w
                .Range("A" & v.Row & ":L" & v.Row).Interior.ColorIndex = 3 + Exact
                Exact = 0
            Next v
            Set c = Nothing
        Else                                                                                        'Si l'id de feuil2 n'existe pas dans feuil1
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 6       'On colorie la plage filtrée en feuil2 en jaune et on la copie en fin de feuil1
            .Range("A2:L" & LastLig2).SpecialCells(xlCellTypeVisible).Copy Sheets("Feuil1").Range("A" & LastLig1 + 1)
        End If
    Next i
    .AutoFilterMode = False
End With                                                                        'on enlève les filtres auto des 2 feuilles
Sheets("Feuil1").AutoFilterMode = False
End Sub

[Lison Lisette]