Comparer deux fichiers excel à l'aide d'une macro VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

14/02/2022, 16h05
said.bouaziz

Comparer deux fichiers excel à l'aide d'une macro VBA

Bonjour,

Étant novice sur le langage VBA, j'aimerais savoir si quelqu'un parmi vous pourrait m'aider à mettre en place une macro qui me permettrait de comparer deux colonnes sur deux fichiers Excel distincts et compléter d'autres colonnes sur le fichier de destination, quand la condition est vérifiée ( quand les valeurs des cellules comparées sont identiques ) .

Par avance merci de votre aide !
14/02/2022, 16h36
mjpmjp

bonjour,
tu est à quelle étape de ton problème ?
quelle est la difficulté par étape ?

a) liaison des fichier
b) comparaison des colonnes

@+JP
14/02/2022, 16h40
said.bouaziz

2 pièce(s) jointe(s)

Bonjour,

Je suis vraiment à la phase initiale.

En résumé, j'aimerais comparer les valeurs de la colonne B du fichier A avec les valeurs de la colonne F du fichier B, si les valeurs sont identiques, il faudrait remplir d'autres colonnes sur le fichier B en se basant sur le fichier A.

Merci pour ton aide !

Pièce jointe 613659

Pièce jointe 613660
14/02/2022, 18h17
Philippe Tulliez
Bonjour,
Si j'ai bien compris les valeurs à comparer dans la colonne F du classeur B sont les 4 derniers caractères de la colonne B du classeur A.
Pour faire ce genre de chose, j'utilise la fonction EQUIV (MATCH pour la version anglaise et en VBA)

A lire éventuellement ces deux billets sur ce sujet
- Comment comparer (matcher) des données dans Excel
- Exporter les données comparées (« Matchées »)

bonjour,
voila un début de liaison entre 2 classeur OUVERT 8O

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Private LigneNB_A As Double
Private LigneNB_B As Double
 
Private Sub CommandButton1_Click()
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B2").End(xlDown).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F2").End(xlDown).Row
    MsgBox LigneNB_A & " et " & LigneNB_B
End Sub

ce bout de code donne le nombre de ligne des 2 zones jaunes

15/02/2022, 12h00
said.bouaziz

Bonjour @mjpmjp,

Merci pour ta réponse.

En effet, je souhaiterais comparer deux fichiers Excel A et B et effectuer quelques manips quand la condition est vérifiée ou pas :

1 - On compare la colonne B du fichier A avec la colonne F du fichier B, si les cellules sont identiques :

--> On remplit les colonnes vertes du fichier B avec les données correspondantes, contenues dans les colonnes vertes du fichier A.

Autre manip supplémentaire :

- Si on s’aperçoit qu'il existe des données sur la colonne B du fichier A mais pas dans la colonne F du fichier B, on ajoute la ligne avec les données correspondantes contenues dans les colonnes vertes du fichier A.

Voici le lien vers les fichiers en question : https://www.cjoint.com/c/LBpkdSUlJrz

1 pièce(s) jointe(s)

bonjour,
on vat procéder par petit bout :D

la colonne F de B ne contient qu'une partie (la partie droite 4) de la colonne B de A :calim2:

oups ... il y a des trous dans les colonnes !!! :aie:

du coup , on change de méthode :
pour avoir le nombre de ligne exact (avec les trous) on part du bas de la feuille !!!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private LigneNB_A As Double 'nombre de ligne max du fichier A colonne B
Private LigneNB_B As Double 'nombre de ligne max du fichier B colonne F
Private LigneExcelNB As Double 'nombre de ligne totale de la feuille excel sur un PC (65635 à 1048576)
Private DataFichAColB As String 'contenu de la colonne B du fichier A
 
Public Sub Cmd1()
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    '----- boucle du fichier A colonne B
    For n = 2 To 2 'LigneNB_A
        DataFichAColB = Right(Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value, 4)
    MsgBox DataFichAColB
    Next n
End Sub

et on garde que la partie droite de la colonne B

Pièce jointe 613742

pour le moment , voila le code principal avec la comparaison et les emplacement (libre) pour le traitement du résultat

Code:

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
 
Private LigneNB_A As Double 'nombre de ligne max du fichier A colonne B
Private LigneNB_B As Double 'nombre de ligne max du fichier B colonne F
Private LigneExcelNB As Double 'nombre de ligne totale de la feuille excel sur un PC (65635 à 1048576)
Private DataFichAColB As String 'contenu de la colonne B du fichier A
Private DataFichBColF As String 'contenu de la colonne F du fichier B
Private DataExiste As Boolean 'si false ajouter le data
 
Public Sub Cmd1()
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    '----- boucle du fichier A colonne B
    For n = 2 To LigneNB_A
        'au début de la recherche le data n'a pas été trouvé
        DataExiste = False
        'lecture de la cellule
        DataFichAColB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value
        'un trou ?
        If DataFichAColB <> "" Then
            DataFichAColB = Right(Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value, 4)
            '----- boucle du fichier B colonne F
            For i = 2 To LigneNB_B
                DataFichBColF = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & i).Value
                'un trou ?
                If DataFichBColF <> "" Then
                    If DataFichAColB = DataFichBColF Then
                        'le data a été trouvé
                        DataExiste = True
                        'completer avec colonne
                    End If
                End If
            Next i
        End If
        'le data a t il été trouvé
        If DataExiste = False Then
            'ajouter le data dans le fichier B
        End If
    Next n
End Sub

à plus tard :D

15/02/2022, 14h56
said.bouaziz

Hello mjpmjp,

J'attends que vous finissiez d'abord les différentes parties du code pour que je puisse l'exécuter de mon côté ?

Merci beaucoup pour votre aide, vous me sauvez ! :D

3 pièce(s) jointe(s)

bonjour,
normalement on est ok :roll:

Pièce jointe 613755

dans la partie gris / bleu , on constate l'ajout dans la suite des colonnes jaunes et vertes...

les déclarations

Code:

1
2
3
4
5
6
7
8
 
Private LigneNB_A As Double 'nombre de ligne max du fichier A colonne B
Private LigneNB_B As Double 'nombre de ligne max du fichier B colonne F
Private LigneExcelNB As Double 'nombre de ligne totale de la feuille excel sur un PC (65635 à 1048576)
Private DataFichAColB As String 'contenu de la colonne B du fichier A
Private DataFichBColF As String 'contenu de la colonne F du fichier B
Private DataExiste As Boolean 'si false ajouter le data
Private LigneOffset As Double 'ligne en plus des lignes de la colonne F du fichier B

la sub

Code:

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
 
Public Sub Cmd1()
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    LigneOffset = 1 'ligne suplémentaire
    '----- boucle du fichier A colonne B
    For n = 2 To LigneNB_A
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k10").Value = n
 
        'au début de la recherche le data n'a pas été trouvé
        DataExiste = False
        'lecture de la cellule
        DataFichAColB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value
        'un trou ?
        If DataFichAColB <> "" Then
            DataFichAColB = Right(DataFichAColB, 4)
            '----- boucle du fichier B colonne F
            For i = 2 To LigneNB_B
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k12").Value = i
 
                DataFichBColF = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & i).Value
                'un trou ?
                If DataFichBColF <> "" Then
                    If DataFichAColB = DataFichBColF Then
                        'le data a été trouvé
                        DataExiste = True
                        'completer avec colonne e,f,g vers i,k,m
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
 
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
 
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
                    End If
                End If
            Next i
        End If
        'le data a t il été trouvé
        If DataExiste = False Then
            'ajouter le data dans le fichier B
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneNB_B).Offset(LigneOffset, 0).Value = DataFichAColB
            'completer avec colonne e,f,g vers i,k,m
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
            'nouvelle ligne suplémentaire
            LigneOffset = LigneOffset + 1
        End If
    Next n
End Sub

ne pas oublier de supprimer les lignes : 15 / 16 et 28 / 29 , qui servent au compteur :D

comme dab les explications son dans le code , mais je suis dispo si il faut approfondir

:coucou: @+ JP

15/02/2022, 16h58
said.bouaziz

Merci beaucoup @mjpmpj ! :D:D

La macro fonctionne et répond exactement à mon besoin initial, quelle magie ! Merci infiniment !

Par ailleurs, j'aimerais savoir si c'est possible de rajouter quelques conditions supplémentaires au code, à savoir :

1 - Si on s’aperçoit que les valeurs copiées dans la colonne I du classeur B sont différentes des valeurs contenues dans la colonne J du même fichier, on met une couleur rouge pour nous alerter.

Exemple :

Si I2 <> de J2 --> on met la cellule I2 en rouge.

2 - Deuxième demande :

C'est possible de mettre les valeurs ajoutées ( que t'as mis dans la partie bleue / gris ) dans une autre couleur ? afin qu'on puisse identifier les lignes ajoutées....

Je ne sais pas si ma demande est claire mais je reste à ta disposition, si nécessaire.

Merci encore et encore !

A+

bonjour,
en fait si tu regardes bien le code , tu as l'impression de t'enfoncer dans les détails :mouarf:
tu part d'une position/condition et plus tu ajoutes des critères plus tu creuses

bref ... en clair :D
à l'emplacement des lignes de code qui écrivent , tu est donc arrivé au fond de ton trou :D , et c'est là que tu vas ajouter un test et en fonction de ce test tu met une couleur ...

pour les couleurs , c'est pas compliqué , tu as 2 façons de faire (je parle du fond de la cellule , pas du texte)

1) avec color index
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Data = Range("F" & n).Value Select Case Data Case Is = ValeurOrigin Range("F" & n).Interior.ColorIndex = 6 Case Is = ValeurMaxi Range("F" & n).Interior.ColorIndex = 3 Case Is = ValeurMini Range("F" & n).Interior.ColorIndex = 4 Case Is > ValeurMini If Data < ValeurMaxi Then Range("F" & n).Interior.ColorIndex = 7 Case Else Range("F" & n).Interior.ColorIndex = 0 End Select
2) avec RGB
Code:

1 2 Range("F" & n).Interior.Color = RGB(192 , 96,132)
pour l'instant si çà peut t'aider ... je vais voir pour ta modif

@+JP

15/02/2022, 18h01
said.bouaziz

Dans quelle partie du code que je dois rajouter ce bout supplémentaire ?

Ce code répond également à la deuxième demande ? à savoir : la coloration des nouvelles lignes ajoutées, si ces dernières n'existent pas dans la colonne F du classeur B.

Désole de t'embêter avec toutes mes questions...

3 pièce(s) jointe(s)

bonjour,

Pièce jointe 613777

j'ai modifié la valeur de la ligne 75 pour activer l'erreur , la vraie valeur est à la ligne 76

voila le code , les déclarations non pas changées

j'ai utilisé les 2 façons pour colorisé les cellules

Code:

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
 
Public Sub Cmd1()
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    LigneOffset = 1 'ligne suplémentaire
    '----- boucle du fichier A colonne B
    For n = 2 To LigneNB_A
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k10").Value = n
 
        'au début de la recherche le data n'a pas été trouvé
        DataExiste = False
        'lecture de la cellule
        DataFichAColB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value
        'un trou ?
        If DataFichAColB <> "" Then
            DataFichAColB = Right(DataFichAColB, 4)
            '----- boucle du fichier B colonne F
            For i = 2 To LigneNB_B
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k12").Value = i
 
                DataFichBColF = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & i).Value
                'un trou ?
                If DataFichBColF <> "" Then
                    If DataFichAColB = DataFichBColF Then
                        'le data a été trouvé
                        DataExiste = True
                        '----- completer avec colonne e,f,g vers i,k,m
                        'écrire dans I
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
                        'test avec colonne J du fichier B si I <> J alors I est en fond rouge
                        If Not Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Value = _
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("J" & i).Value Then
                            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Interior.ColorIndex = 3
                        End If
                        'écrire dans K , pas de test
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
                        'écrire dans M , pas de test
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
                    End If
                End If
            Next i
        End If
        'le data a t il été trouvé
        If DataExiste = False Then
            'ajouter le data dans le fichier B
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneNB_B).Offset(LigneOffset, 0).Value = DataFichAColB
            'completer avec colonne e,f,g vers i,k,m
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
            'fond des nouvelles cellules en couleur bizare
            'utilise RGB pour voir les 2 façons de faire (plus de couleur avec RGB)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            'nouvelle ligne suplémentaire
            LigneOffset = LigneOffset + 1
        End If
    Next n
End Sub

:coucou: @+ JP

15/02/2022, 19h04
said.bouaziz

Excellent ! Merci infiniment l'expert VBA !

La macro répond à toutes mes attentes :D t'es un vrai magicien :lol:

3 pièce(s) jointe(s)

bonjour,

Citation:

Bonjour JP,

Je me permets de te contacter pour t'embêter encore un petit peu lol

En effet, j'aimerais rajouter une instruction supplémentaire au script que t'as développé de telle sorte à colorer ( en orange par exemple ) les valeurs qui existent dans la colonne F du classeur B mais pas dans la colonne B du classeur A.

Tu penses que c'est possible de greffer cette condition de comparaison au script existant ?

Par avance merci de ton aide.

Cordialement,
S.B

voila le résultat

Pièce jointe 613810

il y a maintenant 2 boutons , la nouvelle recherche est de B vers A ... :D

pour le test n'oublie pas de supprimer les données au bout de la colonne "F" du fichier "B"

pour le code , en fait j'ai repris le code de A vers B et bien sur je l'ai adapté :roll:

les déclarations (sont les mêmes)

Code:

1
2
3
4
5
6
7
8
 
Private LigneNB_A As Double 'nombre de ligne max du fichier A colonne B
Private LigneNB_B As Double 'nombre de ligne max du fichier B colonne F
Private LigneExcelNB As Double 'nombre de ligne totale de la feuille excel sur un PC (65635 à 1048576)
Private DataFichAColB As String 'contenu de la colonne B du fichier A
Private DataFichBColF As String 'contenu de la colonne F du fichier B
Private DataExiste As Boolean 'si false ajouter le data
Private LigneOffset As Double 'ligne en plus des lignes de la colonne F du fichier B

la nouvelle SUB : RechercheBA()

Code:

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
 
 
Public Sub RechercheBA()
    'recherche à partir du fichier B vers le fichier A
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    LigneOffset = 1 'ligne suplémentaire
 
    '----- boucle du fichier B colonne F
    For n = 2 To LigneNB_B
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k10").Value = n
 
    'au début de la recherche le data n'a pas été trouvé
        DataExiste = False
        'lecture de la cellule
        DataFichBColF = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & n).Value
        'un trou ?
        If DataFichBColF <> "" Then
            '----- boucle du fichier A colonne B
            For i = 2 To LigneNB_A
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k12").Value = i
 
                DataFichAColB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & i).Value
                'un trou ?
                If DataFichAColB <> "" Then
                    DataFichAColB = Right(DataFichAColB, 4)
                    If DataFichAColB = DataFichBColF Then
                        'le data a été trouvé
                        DataExiste = True
                    End If
                End If
            Next i
            'le data a t il été trouvé
            If DataExiste = False Then
                'ajouter le data dans le fichier A
                Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneNB_A).Offset(LigneOffset, 0).Value = DataFichBColF
                'fond des nouvelles cellules en couleur bizare
                'utilise RGB pour voir les 2 façons de faire (plus de couleur avec RGB)
                Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneNB_A).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
                'nouvelle ligne suplémentaire
                LigneOffset = LigneOffset + 1
            End If
        End If
    Next n
End Sub

la SUB du début (renommée) : RechercheAB()

Code:

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
 
 
Public Sub RechercheAB()
    'recherche à partir du fichier A vers le fichier B
    '----- nombre de lignes d'une feuille Excel
    'classeur_A (celui la)
    LigneExcelNB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("BZ1").End(xlDown).Row
    '----- nombre de lignes des colonnes
    'classeur_A (celui la)
    LigneNB_A = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & LigneExcelNB).End(xlUp).Row
    'classeur_B (l'autre)
    LigneNB_B = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneExcelNB).End(xlUp).Row
    LigneOffset = 1 'ligne suplémentaire
    '----- boucle du fichier A colonne B
    For n = 2 To LigneNB_A
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k10").Value = n
 
        'au début de la recherche le data n'a pas été trouvé
        DataExiste = False
        'lecture de la cellule
        DataFichAColB = Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("B" & n).Value
        'un trou ?
        If DataFichAColB <> "" Then
            DataFichAColB = Right(DataFichAColB, 4)
            '----- boucle du fichier B colonne F
            For i = 2 To LigneNB_B
 
    'a suprimer , uniquement pour le test
    Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("k12").Value = i
 
                DataFichBColF = Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & i).Value
                'un trou ?
                If DataFichBColF <> "" Then
                    If DataFichAColB = DataFichBColF Then
                        'le data a été trouvé
                        DataExiste = True
                        '----- completer avec colonne e,f,g vers i,k,m
                        'écrire dans I
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
                        'test avec colonne J du fichier B si I <> J alors I est en fond rouge
                        If Not Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Value = _
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("J" & i).Value Then
                            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & i).Interior.ColorIndex = 3
                        End If
                        'écrire dans K , pas de test
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
                        'écrire dans M , pas de test
                        Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & i).Value = _
                        Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
                    End If
                End If
            Next i
        End If
        'le data a t il été trouvé
        If DataExiste = False Then
            'ajouter le data dans le fichier B
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneNB_B).Offset(LigneOffset, 0).Value = DataFichAColB
            'completer avec colonne e,f,g vers i,k,m
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("E" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("F" & n).Value
 
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & LigneNB_B).Offset(LigneOffset, 0).Value = _
            Workbooks("Classeur_A.xlsm").Sheets("Feuil1").Range("G" & n).Value
            'fond des nouvelles cellules en couleur bizare
            'utilise RGB pour voir les 2 façons de faire (plus de couleur avec RGB)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("F" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("I" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("K" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            Workbooks("Classeur_B.xlsm").Sheets("Feuil1").Range("M" & LigneNB_B).Offset(LigneOffset, 0).Interior.Color = RGB(205, 169, 35)
            'nouvelle ligne suplémentaire
            LigneOffset = LigneOffset + 1
        End If
    Next n
End Sub

:coucou: @+JP

16/02/2022, 11h48
said.bouaziz

Merci énormément ! :D :D
17/02/2022, 15h45
said.bouaziz

Bonjour JP,

Tu penses que c'est possible d'annuler les effets d'une macro après exécution pour revenir à l'état initial du fichier ?

La seule alternative que j'ai trouvée pour le moment, c'est de fermer le fichier sans l'enregistrer après exécution de la macro, mais ça aurait été bcp mieux si on pouvait avoir une commande équivalente à Ctrl + Z, qui nous permettrait de revenir en arrière...
17/02/2022, 16h36
mjpmjp

bonjour,
je n'ai jamais essayé !!

c'est pour quel genre de macros ?

@+JP
17/02/2022, 16h38
said.bouaziz

N'importe quelle macro :)

Celle que t'as réalisé par exemple, qui compare les deux fichiers Excel...
17/02/2022, 16h49
mjpmjp

bonjour,
si c'est des macros perso et dans certaines conditions , alors oui , en ayant prévu ce genre de chose !!! :D

j'explique
dans notre cas , il s'agit de simple écriture ,
pour annuler il faut reconnaitre ces écritures qui sont temporaires
on peu même définir une date et avoir plusieurs degré de temps :weird: (je réfléchis en même temps que j'écris :ptdr:)

voila l'astuce que je viens d'imaginer (tu me dis ce que tu en pense )
dans une table dédié à la sauvegarde ,
quand on lance la macro , on écrit la date et l'heure dans 2 colonnes et dans la 3°colonne on indique une valeur RGB(1,2,3) ... :calim2:

en fait si on revient en arrière on sélectionne l'heure et donc la couleur (de l'écriture)
et pour annuler on recherche les données écrites avec cette couleur !!

@+JP

Voir 40 message(s) de cette discussion en une page