Remplacement de valeurs de cellules sous conditions
Bonjour,
Je reviens vers vous sur ce forum, après un passage il y a quelques jours pour une autre macro, pour vous demander de nouveau de l'aide si cela était possible.
Je souhaiterais une macro qui va, ligne par ligne, rechercher les cellules dont la valeur est inférieure à 10 fois la valeur référence de la même ligne (condition) puis remplacer la valeur de ces cellules par 0. C'est à dire : sur la ligne 2, recherche des cellules (de E2 à P2 dans le fichier exemple ce joint) répondant à la condition vis à vis de la valeur référence en C2 puis remplacement par 0 lorsque la condition est remplie. Puis sur la ligne 3 recherche des cellules (de E3 à P3) répondant à la condition vis à vis de la valeur référence en C3 puis remplacement par 0 lorsque la condition est remplie.
Ainsi de suite jusqu'à la fin du tableau, en sachant que cette macro doit être applicable quelque soit le nombre de ligne et de colonnes tant que la structure du tableau est la même. En effet je dois effectuer cette opération sur plusieurs fichiers de taille variable...
C'est peut être un code dans le type de celui qui suit mais comme je suis complétement débutante je me trompe peut être totalement !
Dim Drligne&, DrColonne%, A&, Ref&, B%
DrColonne = Cells(1, Columns.Count).End(xlToLeft).Column
Drligne = Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For A = Drligne To 2 Step -1
Ref = Range("C" & A) * 10
For B = 5 To DrColonne
Next B
If Cell.Value < Ref*10 then
Cell.Value = "0"
End if
Next A
Application.ScreenUpdating = TrueVous trouverez ci-joint un fichier servant d'exemple pour la structure des données. Les cellules qui sont en vert sont des cellules qui remplissent la condition vis à vis de la valeur de référence et donc dont la valeur doit être remplacée par 0. La colonne C est la colonne des valeurs de références tandis que les colonnes E à P contiennent les cellules à rechercher.
J'espère avoir été clair. Je reste à votre disposition pour toute autre information.
Je vous remercie par avance pour votre aide.
Cordialement.
Bonjour,
Une piste :
Sub Test()
Dim PlgRef As Range
Dim PlgLig As Range
Dim CelRef As Range
Dim CelLig As Range
With ActiveSheet
Set PlgRef = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
For Each CelRef In PlgRef
Set PlgLig = .Range(.Cells(CelRef.Row, 5), .Cells(CelRef.Row, 16))
For Each CelLig In PlgLig
If CelLig.Value / 10 < CelRef.Value Then CelLig.Value = 0
Next CelLig
Next CelRef
End With
End SubBonjourrr,
ça te convient ?
Sub lel()
Application.ScreenUpdating = False
lig = 2
col = 5
drligne = Range("C" & Rows.Count).End(xlUp).Row
While Cells(lig, col) <> ""
For i = 2 To drligne
If Cells(i, col).Value < Cells(i, "C").Value * 10 Then
Cells(i, col) = 0
End If
Next
If i = drligne + 1 Then
i = 2
lig = 2
col = col + 1
End If
Wend
Application.ScreenUpdating = True
End SubBonjour,
Merci pour des deux macro. Je vois que j'en étais loin
Elles fonctionnement très bien sur mon fichier d'exemple. Je vais effectuer les test sur les véritables fichiers complets et je reviens vers vous.
Juste pour savoir, y a t-il des limites d'applications en terme de taille de tableau pour ce genre de macro?
Je vous remercie encore.
Cordialement.
Bonjour,
J'ai effectué mes tests sur mes fichiers complets, ça marche
Tout est en ordre, merci beaucoup à vous deux !
Merci pour la rapidité de vos réponses !
Bonne journée.
Cordialement.