Macro qui s'exécute à l'infini

life

XLDnaute Nouveau
Bonjour à tous,

Je débute avec excel & vba, ceci dit,
j'ai inséré dans une feuille une 'liste de validation de données'. Une petite macro, s'il y a égalité des valeurs texte, modifie le format de la cellule et incrémente les 2 cellules en dessous d'une valeur numérique. Malheureusement si dans ma liste la valeur est numérique, la macro incrémente toute la colonne.
Comment faire pour que la macro n'agisse que sur ces 2 cellules?

Par avance merci

live
 

life

XLDnaute Nouveau
Désolé,
J'ai cru l'avoir mis, mais j'avais mis un accent,
et pan sur le bec

Merci

live [file name=Heurecondense.zip size=31758]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Heurecondense.zip[/file]
 
Dernière édition:

Blunet

XLDnaute Occasionnel
Salut Live
J'ai pas bien compris ce que fait ton fichier encore moins où intervient le type numérique ou string de ta variable de recherche.
Mais j'ai essayer d'écrire quelque chose je ne sais pas si ça peut t'aider.

Attention ton utilisation des Offset entraine une redondance
et un traitement multiple sur les cellules identiques !!!

Sub Lancer()
For Each nom In Sheets('Feuil1').Range('Liste')
If nom.Offset(0, 1).Value = [Liste].Value Then
nom.Offset(0, 1).Interior.ColorIndex = Range('Liste'). _
Offset(0, 2).Interior.ColorIndex
'Changement de la couleur du texte
nom.Offset(0, 1).Font.Color = Range('Liste').Offset(0, 2).Font.Color
'Chargement des valeurs dans les cellules en dessous
nom.Offset(1, 0).Value = Range('Liste').Offset(0, 3).Value
nom.Offset(2, 0).Value = Range('Liste').Offset(0, 4).Value
End If
Next

End Sub

Sub Proposition()
'J'utilise une boucle For ...
For i = 1 To Range('Liste').EntireRow.Count
For j = 1 To Range('Liste').EntireRow.Count
If Cells(i, 1).Value = Range('Liste').Offset(j, 1).Value Then
Cells(i, 1).Interior.ColorIndex = Range('Liste'). _
Offset(j, 2).Interior.ColorIndex
'Couleur de texte
Cells(i, 1).Font.Color = Range('Liste').Offset(j, 2).Font.Color
'Valeurs des cellules du dessous
Cells(i + 1, 1).Value = Range('Liste').Offset(0, 2 + j).Value
Cells(i + 2, 1).Value = Range('Liste').Offset(0, 3 + j).Value
i = i + 2
End If
Next j
Next i
End Sub

Dans 1er code j'essayais de traduire ce qui se trouve dans ton fichier. Le second essaye de répondre à ta préoccupation

Ciao
 

life

XLDnaute Nouveau
Je te remercie 'Blunet' et je m'applique à bien comprendre le code proposé(c'est pas gagné:eek:), je joint un nouveau fichier avec quelques explications plus précises

Merci et bon Noël à tous [file name=Heurescondense2.zip size=33030]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Heurescondense2.zip[/file]
 
Dernière édition:

Discussions similaires