Discussion :

[said.bouaziz]

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 !

[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

[said.bouaziz]

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 !

[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 »)

[mjpmjp]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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

[mjpmjp]

bonjour,
on vat procéder par petit bout

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

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

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 :

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
 
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



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

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
 
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

[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 !

[mjpmjp]

bonjour,
normalement on est ok



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

les déclarations

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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
 
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

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

@+ JP

[said.bouaziz]

Merci beaucoup @mjpmpj !

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+

[mjpmjp]

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

bref ... en clair
à l'emplacement des lignes de code qui écrivent , tu est donc arrivé au fond de ton trou , 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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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...

[mjpmjp]

bonjour,



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 :

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
 
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

@+ JP

[said.bouaziz]

Excellent ! Merci infiniment l'expert VBA !

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

[mjpmjp]

bonjour,

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



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

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é

les déclarations (sont les mêmes)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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
 
 
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 :

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
 
 
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

@+JP

[said.bouaziz]

Merci énormément !

[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...

[mjpmjp]

bonjour,
je n'ai jamais essayé !!

c'est pour quel genre de macros ?

@+JP

[said.bouaziz]

N'importe quelle macro

Celle que t'as réalisé par exemple, qui compare les deux fichiers Excel...

[mjpmjp]

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

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 (je réfléchis en même temps que j'écris )

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) ...

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