Remplacer les cellules qui ont une valeur de 0 par (-1,0)

  • Initiateur de la discussion Initiateur de la discussion bloomby
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

bloomby

XLDnaute Occasionnel
Bonjour à tous,

Je cherche à créer une macro qui va : lorsqu'une cellule = 0 La macro va prendre la valeur dans la cellule dessous et la copier coller dans la cellule qui a la valeur 0. Ce principle pour toute les cellules dans la feuille.

Par exemple A10= 0 A11= 12
la macro va faire en sorte que A10=12 A11=12

Job75 m'avait aider à créer un code qui supprimait les lignes dans lesquels il y avait une valeur de 0, Cela peu peut-être servir de base de départ

voici le code
HTML:
Private Sub Worksheet_Calculate()
Call SuppLigne
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Call SuppLigne
End Sub

Sub SuppLigne()
Dim cel As Range
Application.EnableEvents = False
On Error Resume Next
1 Set cel = Cells.Find("0", LookIn:=xlValues, LookAt:=xlWhole)
If Not cel Is Nothing Then
cel.EntireRow.Delete 'valeurs 0
Cells.SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete 'formules renvoyant une valeur d'erreur
GoTo 1
End If
Application.EnableEvents = True
End Sub

merci
 
Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Bonsoir bloomby,

peut-être tout simplement comme cela:
Code:
Sub remplacer()
If ActiveCell.Value = 0 Then ActiveCell.Value = ActiveCell.Offset(1, 0) ' cellule juste en dessous
End Sub

Sinon définir peut-être une plage de cellule dans laquelle elle s'applique.

Edit: tu peux aussi le placer directement ici:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Value = 0 Then ActiveCell.Value = ActiveCell.Offset(1, 0)

End Sub
Mais là elle se lance à chaque changement de cellule!

Pour limiter la plage de la macro, rajouter ceci juste avant le IF:
If Not Intersect(Target, Range("A1:A" & Range("A65536").End(xlUp).Row)) Is Nothing Then
'puis le code ci-dessus
'adapter la plage à ton cas
 
Dernière édition:
Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Re,
Il ya ceci qui fonctionne bien:
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:AP150")) Is Nothing Then
If ActiveCell.Value = 0 Then ActiveCell.Value = ActiveCell.Offset(1, 0)
End If
End Sub
Mais cela fonctionne que pour la cellule active.
Pour toutes les cellules de la plage A1:AP150, il faut faire une boucle comme ceci dans un module:
Code:
Sub remplacer()
Dim target, plage As Range
Application.ScreenUpdating = False
Set plage = Range("A1:AP150")
For Each target In plage
If target.Value = 0 Then target.Value = target.Offset(1, 0)
Next target

Application.ScreenUpdating = True

End Sub

Seul soucis la macro considère une cellule vide comme une valeur 0 (null).

Je t'ai mis un exemple, regarde bien les cellules en jaunes (certaines sont vides), puis click sur le bouton test.
 

Pièces jointes

Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Salut alex,

merci de ton aide, ton fichier fonctionn très bien !!!
Par contre, cette facon de faire est pour l'instant quelque peu longue étant donnée que j'ai 5 pages à faire vérifier

j'ai essayer ce code suivant:
(mais il me resterais à définir une plage pour optimiser la recherche, est-ce que tu aurais une idée)

HTML:
Dim Data3 As Worksheet

Sub Change_Data3_Cel_Zero()
Dim cel As Range
Application.EnableEvents = False
On Error Resume Next

Set Data3 = ThisWorkbook.Sheets("DATA3")
Data3.Activate
1 Set cel = Cells.Find("0", LookIn:=xlValues, LookAt:=xlWhole)
If Not cel Is Nothing Then
cel.Value = cel.Offset(1, 0) 'Valeur dessous

GoTo 1
End If
Application.EnableEvents = True
End Sub

Bloomby
 
Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Bonjour Blommby, le forum,

j'ai trouvé ceci en fouillant un peu:
Range("B7:B22").Select
Selection.Find("0", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= False
).Activate
Range(ActiveCell.Address).Select

Je pensais qu'effectivement il fallait sélectionner une plage de cellule, ce qui a l'air d'être le cas avec cette méthode, essai .

Pour ton cas la plage serait (c'est un exemple) :
Code:
Set Data3 = ThisWorkbook.Sheets("DATA3").Range("B7:B22")
DATA3.Select

Regarde si tu arrive à l'adapter (elle n'est pas de moi)

Edit: c'est vrai qu'il est souvent inutile d'utiliser les select, essai de simplifier ainsi:
Code:
DATA3.Find("0", [COLOR="Red"]LookIn:=xlValues, LookAt:=xlPart, _ 
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= False[/COLOR]).Activate
Range(ActiveCell.Address)= Range(Activecell.Offset(1,0) 'j'ai fait cette partie à main levée, donc pas certain que ça marche:o
 
Dernière édition:
Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Bonjour forum, Bonjour alex,

Je joins le fichier adapté, par contre je ne sais pas pourquoi mais la macro ne fonctionne pas pour toute les cellules sélectionné.

Deplus, il faudrait que la macro commence à changer les "0" pour (1,0) à partir du bas de la feuille.

HTML:
Sub Change_Data1_Cel_Zero()
Dim cel As Range
Application.EnableEvents = False
On Error Resume Next

Sheets("Sheet1").Activate

Range("C2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select

1 Set cel = Selection.Find("0", LookIn:=xlValues, LookAt:=xlWhole)
If Not cel Is Nothing Then
cel.Value = cel.Offset(1, 0)
GoTo 1
End If
Application.EnableEvents = True

End Sub
 

Pièces jointes

Re : Remplacer les cellules qui ont une valeur de 0 par (-1,0)

Bonjour bloomby,
Salut "voisin" 😉,

en partant du bas de la feuille:

Code:
Sub Change_Data1_Cel_Zero()
With Range("C2").CurrentRegion
    Set Trouve = .Find("0", after:=Range("C2").CurrentRegion(Range("C2").CurrentRegion.Count), LookIn:=xlFormulas, lookat:=xlWhole, SearchDirection:=xlPrevious)
    If Not Trouve Is Nothing Then
        Do
            Trouve.Value = Trouve.Offset(1, 0).Value
            Set Trouve = .FindPrevious(Trouve)
        Loop While Not Trouve Is Nothing
    End If
End With
End Sub
Bon WE.
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
3
Affichages
926
D
Réponses
4
Affichages
948
D
J
Réponses
22
Affichages
3 K
jui42
J
R
Réponses
3
Affichages
3 K
Ricouch
R
Retour