Macro qui detecte et signale les différenc
Fermé
Mila
-
13 avril 2009 à 18:47
Mike-31 Messages postés 18188 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 mars 2023 - 19 avril 2009 à 22:01
Mike-31 Messages postés 18188 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 13 mars 2023 - 19 avril 2009 à 22:01
A voir également:
- Macro qui detecte et signale les différenc
- Macro logiciel - Télécharger - Organisation
- Reseau orange non détecté ✓ - Forum Livebox
- Macro recorder - Télécharger - Confidentialité
- Macro Recorder - Télécharger - Divers Utilitaires
- Macro word - Guide
9 réponses
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
13 avril 2009 à 22:20
13 avril 2009 à 22:20
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+
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
14 avril 2009 à 19:44
14 avril 2009 à 19:44
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
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
15 avril 2009 à 10:34
15 avril 2009 à 10:34
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...!
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
15 avril 2009 à 17:47
15 avril 2009 à 17:47
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+
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
>
mila
15 avril 2009 à 18:09
15 avril 2009 à 18:09
Re,
Tu aurais dû le dire dès le départ, au début nous étions sur une colonne puis quatre et maintenant 90
Je revoie le code
A+
Tu aurais dû le dire dès le départ, au début nous étions sur une colonne puis quatre et maintenant 90
Je revoie le code
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...
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
18 avril 2009 à 15:08
18 avril 2009 à 15:08
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
Mike-31
Messages postés
18188
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
13 mars 2023
5 041
19 avril 2009 à 22:01
19 avril 2009 à 22:01
Salut,
Tu as quelques explications sur ton fichier, de mon coté je vais t'écrire un code différent
A+
Tu as quelques explications sur ton fichier, de mon coté je vais t'écrire un code différent
A+
14 avril 2009 à 18:42
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!!