Macro qui detecte et signale les différenc
Mila
-
Mike-31 Messages postés 19571 Date d'inscription Statut Contributeur Dernière intervention -
Mike-31 Messages postés 19571 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je souhaiterai créer une macro pour comparer les valeurs dans plusieurs lignes d'une feuille xls.
Voici un exemple :
https://www.cjoint.com/?enc7i2nTXH
Ce que je veux c'est :
A partir de la colonne A pour la premiere valeur, je compare les cellule de cette ligne (de la colle A à la colonen D) avec les autres lignes qui ont cette valeur en A.
Si des valeurs sont différentes, je mets les cellules en rouge.
Si une cellule est vide, je mets la valeur que j'ai trouvé dan sune autre ligne et la case devient verte.
Dans mon exemple ca donne ca :
La cellule B7 devient rouge (car différente de la cellule B2)
Dans la cellule B3 vient s'inscrire "camille" et se met en vert
J'espere etre clair, n'hésitez pas si je peux apporter des compléments.
Merci pour votre aide
Je souhaiterai créer une macro pour comparer les valeurs dans plusieurs lignes d'une feuille xls.
Voici un exemple :
https://www.cjoint.com/?enc7i2nTXH
Ce que je veux c'est :
A partir de la colonne A pour la premiere valeur, je compare les cellule de cette ligne (de la colle A à la colonen D) avec les autres lignes qui ont cette valeur en A.
Si des valeurs sont différentes, je mets les cellules en rouge.
Si une cellule est vide, je mets la valeur que j'ai trouvé dan sune autre ligne et la case devient verte.
Dans mon exemple ca donne ca :
La cellule B7 devient rouge (car différente de la cellule B2)
Dans la cellule B3 vient s'inscrire "camille" et se met en vert
J'espere etre clair, n'hésitez pas si je peux apporter des compléments.
Merci pour votre aide
A voir également:
- Macro qui detecte et signale les différenc
- Cle usb qui ne se detecte pas - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Un hyperviseur a été détecté. les fonctionnalités nécessaires à hyper-v ne seront pas affichées. - Windows 11
9 réponses
Salut,
Dans la Thisworkbook un code posait quelques problèmes que j'ai viré, testes le code ci-dessous qui se trouve dans un module.
Tu peux récupérer ton fichier pour le tester avec ce lien
https://www.cjoint.com/?epl7HONypl
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Dans la Thisworkbook un code posait quelques problèmes que j'ai viré, testes le code ci-dessous qui se trouve dans un module.
Tu peux récupérer ton fichier pour le tester avec ce lien
https://www.cjoint.com/?epl7HONypl
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Salut,
pas forcement rajouter un For, que veux tu faire, exactement la même chose que sur la colonne B si une cellule est vide prendre la valeur de la cellule du dessus et mette en rouge le changement
ou par rapport a ce qui est fait en colonne B mettre la ligne en rouge ou en vert avec copie de la valeur du dessus.
A l’usage peut il y avoir plusieurs cellules vides qui correspondent à un nom
A+
pas forcement rajouter un For, que veux tu faire, exactement la même chose que sur la colonne B si une cellule est vide prendre la valeur de la cellule du dessus et mette en rouge le changement
ou par rapport a ce qui est fait en colonne B mettre la ligne en rouge ou en vert avec copie de la valeur du dessus.
A l’usage peut il y avoir plusieurs cellules vides qui correspondent à un nom
A+
Je veux faire pareil que dans la colonne B dan sles autres colonnes.
Toujours par rapport à la colonne A si il y a les memes valeurs dans la colonne A, je compare les cellules colonne par colonne et je mets en rouge les cellules qui ont une valeur différente et en vert si une est vide et pas les autres.
C'est difficile a expliquer, j'espere que tu comprend sce que je veux dire
Toujours par rapport à la colonne A si il y a les memes valeurs dans la colonne A, je compare les cellules colonne par colonne et je mets en rouge les cellules qui ont une valeur différente et en vert si une est vide et pas les autres.
C'est difficile a expliquer, j'espere que tu comprend sce que je veux dire
Salut,
Colles ce code dans un module et dis nous si'il répond à tes attentes
Sub Macro1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
'Colorise en vert
If Cells(i, 2) = "" Then Cells(i, 2).Interior.ColorIndex = 4
If Cells(i, 3) = "" Then Cells(i, 3).Interior.ColorIndex = 4
If Cells(i, 4) = "" Then Cells(i, 4).Interior.ColorIndex = 4
'copie le texte de la cellule précédente dans deux cellules vide qui suivent
If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
If Cells(i + 1, 2) = "" Then Cells(i + 1, 2) = Cells(i - 1, 2)
If Cells(i + 2, 2) = "" Then Cells(i + 2, 2) = Cells(i - 1, 2)
If Cells(i + 3, 2) = "" Then Cells(i + 3, 2) = Cells(i - 1, 2)
End If
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Colles ce code dans un module et dis nous si'il répond à tes attentes
Sub Macro1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
'Colorise en vert
If Cells(i, 2) = "" Then Cells(i, 2).Interior.ColorIndex = 4
If Cells(i, 3) = "" Then Cells(i, 3).Interior.ColorIndex = 4
If Cells(i, 4) = "" Then Cells(i, 4).Interior.ColorIndex = 4
'copie le texte de la cellule précédente dans deux cellules vide qui suivent
If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
If Cells(i + 1, 2) = "" Then Cells(i + 1, 2) = Cells(i - 1, 2)
If Cells(i + 2, 2) = "" Then Cells(i + 2, 2) = Cells(i - 1, 2)
If Cells(i + 3, 2) = "" Then Cells(i + 3, 2) = Cells(i - 1, 2)
End If
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Bonjour,
En fait ce qui m'allait c'est de faire ça:
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 4 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
If Cells(x, 3) = "" Then Cells(x, 3).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 3) = "" Then Cells(x, 3) = Cells(x - 1, 3)
If Cells(x, 4) = "" Then Cells(x, 4).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 4) = "" Then Cells(x, 4) = Cells(x - 1, 4)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
Mais problème est que ce tableau est un exemple et qu'en fait je voudrais faire ca sur 90 colonnes...
D'ou le fait que je voulais faire un FOR!
En fait ce qui m'allait c'est de faire ça:
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 4 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
If Cells(x, 3) = "" Then Cells(x, 3).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 3) = "" Then Cells(x, 3) = Cells(x - 1, 3)
If Cells(x, 4) = "" Then Cells(x, 4).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 4) = "" Then Cells(x, 4) = Cells(x - 1, 4)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
Mais problème est que ce tableau est un exemple et qu'en fait je voudrais faire ca sur 90 colonnes...
D'ou le fait que je voulais faire un FOR!
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
En fait, ca marche quand je fais ca :
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 4 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
If Cells(x, 3) = "" Then Cells(x, 3).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 3) = "" Then Cells(x, 3) = Cells(x - 1, 3)
If Cells(x, 4) = "" Then Cells(x, 4).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 4) = "" Then Cells(x, 4) = Cells(x - 1, 4)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
Mon probleme est que ce tableau est un exemple et qu'en fait je dois faire ca sur 90 colonnes, c'est pour ca que je voulais faire un FOR...!
Sub Recherche_Différence()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
Next i
For x = [A65000].End(xlUp).Row To 4 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
'Colorise en vert
If Cells(x, 2) = "" Then Cells(x, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 2) = "" Then Cells(x, 2) = Cells(x - 1, 2)
If Cells(x, 3) = "" Then Cells(x, 3).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 3) = "" Then Cells(x, 3) = Cells(x - 1, 3)
If Cells(x, 4) = "" Then Cells(x, 4).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(x, 4) = "" Then Cells(x, 4) = Cells(x - 1, 4)
End If
Next x
Application.Calculation = xlCalculationAutomatic
End Sub
Mon probleme est que ce tableau est un exemple et qu'en fait je dois faire ca sur 90 colonnes, c'est pour ca que je voulais faire un FOR...!
Re,
Copies plutôt ce code plus court et avec seulement un for i,
Par contre peut il y avoir plusieurs cellules vide à la suite
Sub Recherche_DifférenceTer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
If Cells(i, 1) = Cells(i - 1, 1) Then
'Colorise en vert
If Cells(i, 2) = "" Then Cells(i, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
If Cells(i, 3) = "" Then Cells(i, 3).Interior.ColorIndex = 4
If Cells(i, 3) = "" Then Cells(i, 3) = Cells(i - 1, 3)
If Cells(i, 4) = "" Then Cells(i, 4).Interior.ColorIndex = 4
If Cells(i, 4) = "" Then Cells(i, 4) = Cells(i - 1, 4)
End If
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Copies plutôt ce code plus court et avec seulement un for i,
Par contre peut il y avoir plusieurs cellules vide à la suite
Sub Recherche_DifférenceTer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[A1].Sort Key1:=Range("A1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlDescending, Header:=xlGuess
For i = [A65000].End(xlUp).Row To 4 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
'colorise en rouge
If Cells(i, 2) <> Cells(i - 1, 2) Then Cells(i, 2).Interior.ColorIndex = 3
If Cells(i, 3) <> Cells(i - 1, 3) Then Cells(i, 3).Interior.ColorIndex = 3
If Cells(i, 4) <> Cells(i - 1, 4) Then Cells(i, 4).Interior.ColorIndex = 3
End If
If Cells(i, 1) = Cells(i - 1, 1) Then
'Colorise en vert
If Cells(i, 2) = "" Then Cells(i, 2).Interior.ColorIndex = 4
'copie la cellule précédente
If Cells(i, 2) = "" Then Cells(i, 2) = Cells(i - 1, 2)
If Cells(i, 3) = "" Then Cells(i, 3).Interior.ColorIndex = 4
If Cells(i, 3) = "" Then Cells(i, 3) = Cells(i - 1, 3)
If Cells(i, 4) = "" Then Cells(i, 4).Interior.ColorIndex = 4
If Cells(i, 4) = "" Then Cells(i, 4) = Cells(i - 1, 4)
End If
Next i
Application.Calculation = xlCalculationAutomatic
End Sub
A+
Bonjour,
Désolée, je pensais que j'étais claire dès le début...
C'est de ma faute, je pensais qu'il suffisait de trouver le truc pour une colonne et qu'apres un FOR arrangerait tout...
Vraiment désolée...
Désolée, je pensais que j'étais claire dès le début...
C'est de ma faute, je pensais qu'il suffisait de trouver le truc pour une colonne et qu'apres un FOR arrangerait tout...
Vraiment désolée...
Salut,
Je ne t'ai pas oublié, un petit contre temps récupères un exemple à tester avec ce lien et on en reparle
https://www.cjoint.com/?eueUyLFGR1
A+
Je ne t'ai pas oublié, un petit contre temps récupères un exemple à tester avec ce lien et on en reparle
https://www.cjoint.com/?eueUyLFGR1
A+
Merci beaucoup,
J'ai testé ca sur un fichier et il y a plein d'erreurs :
https://www.cjoint.com/?evjWtoZXSz
Pourquoi dans D6 il y a cette date alors que pour "faure" la date est 31/12/2009 sur l'autre ligne?
Pourquoi B6 est en rouge alors que c'est égal à B7?
Pourquoi B9 et C9 sont en rouge alors qu'ils sont égaux à B10 et C10?
...
J'ai mis dans l'onglet ACTION les boutons pour faire les actions et dans l'onglet INITIAL le fichier initial à traiter
Merci
J'ai testé ca sur un fichier et il y a plein d'erreurs :
https://www.cjoint.com/?evjWtoZXSz
Pourquoi dans D6 il y a cette date alors que pour "faure" la date est 31/12/2009 sur l'autre ligne?
Pourquoi B6 est en rouge alors que c'est égal à B7?
Pourquoi B9 et C9 sont en rouge alors qu'ils sont égaux à B10 et C10?
...
J'ai mis dans l'onglet ACTION les boutons pour faire les actions et dans l'onglet INITIAL le fichier initial à traiter
Merci
Par contre, sans vouloir abuser, j'aimerais que cette verification ne se fasse pas que sur la 2eme colonne mais sur les 4 colonnes.
Il doit falloir que je rajoute un for J=... mais je sais pas faire!!