Colonne A et B couleur une ligne sur deux
Résolu
Dudulleray
-
Dudulleray -
Dudulleray -
Bonsoir a toutes et tous, Forum
J'ai une liste dans la colonne (A) et une autre dans la colonne (B)
Afin de mieux me repérer je souhaiterai svp un petit code VBA pour colorer
une ligne sur deux, peut importe la couleur, en espèrant que cela ne ralentisse
pas trop le déroulement du programme.
Je souhaiterai également colorer ces lignes jusqu'a la fin des listes
sinon inutile de colorer jusqu'a la fin des lignes d'excel 2007
Le top aurai été une petite barre d'une couleur descendant ou montante avec les flèches
de direction, voir la molette de la souris.
Bon la, je rève, noël est passé, dommage.
merci d'avance de votre aide et de votre temps
bonne soirée a vous tous
Cordialement Ray
J'ai une liste dans la colonne (A) et une autre dans la colonne (B)
Afin de mieux me repérer je souhaiterai svp un petit code VBA pour colorer
une ligne sur deux, peut importe la couleur, en espèrant que cela ne ralentisse
pas trop le déroulement du programme.
Je souhaiterai également colorer ces lignes jusqu'a la fin des listes
sinon inutile de colorer jusqu'a la fin des lignes d'excel 2007
Le top aurai été une petite barre d'une couleur descendant ou montante avec les flèches
de direction, voir la molette de la souris.
Bon la, je rève, noël est passé, dommage.
merci d'avance de votre aide et de votre temps
bonne soirée a vous tous
Cordialement Ray
A voir également:
- Colonne A et B couleur une ligne sur deux
- Déplacer une colonne excel - Guide
- Comment faire deux colonnes sur word - Guide
- Comment trier une colonne sur excel - Guide
- Partager photos en ligne - Guide
- Aller à la ligne excel - Guide
34 réponses
Bonjour Mike, Forum
Merci beucoup pour le code, j'ai créer un bouton et coller le code
je lance le programme et quand je clic sur le bouton le code tourne
le curseur (sablier) ne cesse de clignoter
obliger de stopper par CTRL + PAUSE
le débogeur me met la ligne ci dessous en jaune
pas de plantage mais ca tourne en permanence
Encore merci je te souhaite une bonne journée
Raymond
Merci beucoup pour le code, j'ai créer un bouton et coller le code
je lance le programme et quand je clic sur le bouton le code tourne
le curseur (sablier) ne cesse de clignoter
obliger de stopper par CTRL + PAUSE
le débogeur me met la ligne ci dessous en jaune
Cells(M, "C").Font.ColorIndex = xlAutomatic
pas de plantage mais ca tourne en permanence
Encore merci je te souhaite une bonne journée
Raymond
Re,
cette ligne n'est pas importante, elle remet la couleur police en automatique, dans un premier temps isole la en plaçant en début de ligne une apostrophe comme ceci la ligne deviendra verte et relançe la macro voir
'Cells(M, "C").Font.ColorIndex = xlAutomatic
As tu testé mon fichier et rencontres tu le même problème
cette ligne n'est pas importante, elle remet la couleur police en automatique, dans un premier temps isole la en plaçant en début de ligne une apostrophe comme ceci la ligne deviendra verte et relançe la macro voir
'Cells(M, "C").Font.ColorIndex = xlAutomatic
As tu testé mon fichier et rencontres tu le même problème
Salut Mike
j'ai regarder et fait comme tu me le demande mais le débogeur affiche en jone
la ligne en dessous Cells(M, "C").Font.ColorIndex = xlAutomatic
avec toujours le sablier qui clignote
je t'envoi le fichier que je me sers comme ca tu verra mieux
si besoin explication pas de soucis
http://cjoint.com/?3AEiTzNS3xP
Merci a toi
j'ai regarder et fait comme tu me le demande mais le débogeur affiche en jone
la ligne en dessous Cells(M, "C").Font.ColorIndex = xlAutomatic
avec toujours le sablier qui clignote
je t'envoi le fichier que je me sers comme ca tu verra mieux
si besoin explication pas de soucis
http://cjoint.com/?3AEiTzNS3xP
Merci a toi
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Re,
vite fait,
remplace le code du bouton1 par ça et teste le je n'ai pas le temps
Private Sub CommandButton1_Click()
For L = 1 To [A65536].End(xlUp).Row
If Cells(L, "A") Like "*.avi*" And Cells(L, "B") Like "*.jpg*" Then
Cells(L, "C") = ""
Cells(L, "C").Font.ColorIndex = xlAutomatic
Else
Cells(L, "C") = "erreur"
Cells(L, "C").Font.ColorIndex = 3
End If
Next
End Sub
Pourquoi le bouton Répertoire vidéo efface tes données ?
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
vite fait,
remplace le code du bouton1 par ça et teste le je n'ai pas le temps
Private Sub CommandButton1_Click()
For L = 1 To [A65536].End(xlUp).Row
If Cells(L, "A") Like "*.avi*" And Cells(L, "B") Like "*.jpg*" Then
Cells(L, "C") = ""
Cells(L, "C").Font.ColorIndex = xlAutomatic
Else
Cells(L, "C") = "erreur"
Cells(L, "C").Font.ColorIndex = 3
End If
Next
End Sub
Pourquoi le bouton Répertoire vidéo efface tes données ?
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
Re Mike
Bon j'ai essayer ta modification, ca plante pas, et c'est rapide.
j'ai donc modifier un nom d'une vidéo dans le listing du disc E volontairement
j'ai charger le listing l'erreur est bien présente
j'ai lancer ton code ca fonctionne bien rapidement mais il ne trouve pas d'erreur
Exemple
Tintin.avi Tintin.jpg >>> original
Tintin.avi Tintinne.jpg >>> Modifier pour provoquer une erreur le code n'a pas
trouver l'erreur pourtant évidente.
j'efface les données au début pour etre sur qu'il ni a pas d'erreur au chargement
si ca devient inutile je supprimerai par la suite.
Merci Mike a plus tard
Ray
Bon j'ai essayer ta modification, ca plante pas, et c'est rapide.
j'ai donc modifier un nom d'une vidéo dans le listing du disc E volontairement
j'ai charger le listing l'erreur est bien présente
j'ai lancer ton code ca fonctionne bien rapidement mais il ne trouve pas d'erreur
Exemple
Tintin.avi Tintin.jpg >>> original
Tintin.avi Tintinne.jpg >>> Modifier pour provoquer une erreur le code n'a pas
trouver l'erreur pourtant évidente.
j'efface les données au début pour etre sur qu'il ni a pas d'erreur au chargement
si ca devient inutile je supprimerai par la suite.
Merci Mike a plus tard
Ray
Re,
Normal je n'ai contrôlé que l'extension exemple ligne 534 ou avi est saisie Avi
je compléte le code pour tester également l'orthographe
Normal je n'ai contrôlé que l'extension exemple ligne 534 ou avi est saisie Avi
je compléte le code pour tester également l'orthographe
Re,
entre deux, remplace le code des propriétés bouton par celui ci
Private Sub CommandButton1_Click()
Dim M, I, K As Variant
On Error Resume Next
For M = 1 To [A65536].End(xlUp).Row
I = Len(Cells(M, "A")) - 4
K = Len(Cells(M, "B")) - 4
If Cells(M, "A") Like "*.avi*" And Cells(M, "B") Like "*.jpg*" And Left(Cells(M, "A"), I) = Left(Cells(M, "B"), K) Then
Cells(M, "C") = ""
Cells(M, "C").Font.ColorIndex = xlAutomatic
Else
Cells(M, "C") = "erreur"
Cells(M, "C").Font.ColorIndex = 3
End If
Next
End Sub
je regarde si on peut l'accélérer un peu
En A601 il faut insérer une cellule et saisir le titre The expendables 2 manquant
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
entre deux, remplace le code des propriétés bouton par celui ci
Private Sub CommandButton1_Click()
Dim M, I, K As Variant
On Error Resume Next
For M = 1 To [A65536].End(xlUp).Row
I = Len(Cells(M, "A")) - 4
K = Len(Cells(M, "B")) - 4
If Cells(M, "A") Like "*.avi*" And Cells(M, "B") Like "*.jpg*" And Left(Cells(M, "A"), I) = Left(Cells(M, "B"), K) Then
Cells(M, "C") = ""
Cells(M, "C").Font.ColorIndex = xlAutomatic
Else
Cells(M, "C") = "erreur"
Cells(M, "C").Font.ColorIndex = 3
End If
Next
End Sub
je regarde si on peut l'accélérer un peu
En A601 il faut insérer une cellule et saisir le titre The expendables 2 manquant
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
Re Mike
Merci beaucoup, bien recu les modifications je fait des essais en provocant des erreurs volontairement et je te tient au courant
A plus tard bonne après midi
Raymond
Merci beaucoup, bien recu les modifications je fait des essais en provocant des erreurs volontairement et je te tient au courant
A plus tard bonne après midi
Raymond
Re Mike
Bon j'ai fait pas mal d'essais c'est bon apparament toutes les erreurs que j'ai provoquer ont étées trouvées par ton code de test
Pour la vitesse d'exécution je pense que lorsque je vais rajouter des lignes, cela ne pénalise la vitesse.
qu'en penses tu svp
A plus tard Ray
Bon j'ai fait pas mal d'essais c'est bon apparament toutes les erreurs que j'ai provoquer ont étées trouvées par ton code de test
Pour la vitesse d'exécution je pense que lorsque je vais rajouter des lignes, cela ne pénalise la vitesse.
qu'en penses tu svp
A plus tard Ray
Re,
Si tu utilise ce code il te donnera en plus la durée d'exécution qui actuellement est moins de 4 secondes
Private Sub CommandButton1_Click()
Dim M, I, K As Variant
Dim start As Single
start = Timer
For M = 1 To [A65536].End(xlUp).Row
I = Len(Cells(M, "A")) - 4
K = Len(Cells(M, "B")) - 4
If Cells(M, "A") Like "*.avi*" And Cells(M, "B") Like "*.jpg*" And Left(Cells(M, "A"), I) = Left(Cells(M, "B"), K) Then
Cells(M, "C") = ""
Cells(M, "C").Font.ColorIndex = xlAutomatic
Else
Cells(M, "C") = "erreur"
Cells(M, "C").Font.ColorIndex = 3
End If
Next
MsgBox "durée du traitement: " & Format(Timer - start + 1, "0.00") & " secondes"
End Sub
Si tu utilise ce code il te donnera en plus la durée d'exécution qui actuellement est moins de 4 secondes
Private Sub CommandButton1_Click()
Dim M, I, K As Variant
Dim start As Single
start = Timer
For M = 1 To [A65536].End(xlUp).Row
I = Len(Cells(M, "A")) - 4
K = Len(Cells(M, "B")) - 4
If Cells(M, "A") Like "*.avi*" And Cells(M, "B") Like "*.jpg*" And Left(Cells(M, "A"), I) = Left(Cells(M, "B"), K) Then
Cells(M, "C") = ""
Cells(M, "C").Font.ColorIndex = xlAutomatic
Else
Cells(M, "C") = "erreur"
Cells(M, "C").Font.ColorIndex = 3
End If
Next
MsgBox "durée du traitement: " & Format(Timer - start + 1, "0.00") & " secondes"
End Sub
Re Salut Mike
J'ai tester ton nouveau code déja pour ca merci.
Tout semble fonctionner correctement et rapidement
j'ai fait 17 erreurs volontaire dans le listing d'origine DD(E)
j'ai lancer le programme charger 743 lignes et les 17 erreurs ont été trouver
sur mon PC en 1,49 s que puis-je te dire c'est super extra rapide
cela me convient parfaitement bien
quand pense tu svp
Raymond
J'ai tester ton nouveau code déja pour ca merci.
Tout semble fonctionner correctement et rapidement
j'ai fait 17 erreurs volontaire dans le listing d'origine DD(E)
j'ai lancer le programme charger 743 lignes et les 17 erreurs ont été trouver
sur mon PC en 1,49 s que puis-je te dire c'est super extra rapide
cela me convient parfaitement bien
quand pense tu svp
Raymond
