Supprimer des cellules via macros
Résolu
rico_blues
-
-
-
Bonjour,
Après pas mal de recherche, je me trouve bloquer sur le sujet qui suit:
Sur plusieurs colonnes (nombres variables), je souhaite dans un premier temps supprimer les cellules contenant ** puis recaler le reste de la colonne vers le haut. Dans un second tant, je souhaite suprimer les valeurs d'une cellule trop proches de la suivante.
Ex:
Col1 --- Col2 .... => Col1 --- Col2
** --- 10 1 --- 10
** --- 20 2 --- 20
1 --- 30 3 --- 30
2 --- 40 4 --- 40
2 --- **
3 --- **
4 --- **
** --- **
** --- **
J'ai testé plusieur solution sans parvenir à un résultat probant.
Merci de votre aide
Après pas mal de recherche, je me trouve bloquer sur le sujet qui suit:
Sur plusieurs colonnes (nombres variables), je souhaite dans un premier temps supprimer les cellules contenant ** puis recaler le reste de la colonne vers le haut. Dans un second tant, je souhaite suprimer les valeurs d'une cellule trop proches de la suivante.
Ex:
Col1 --- Col2 .... => Col1 --- Col2
** --- 10 1 --- 10
** --- 20 2 --- 20
1 --- 30 3 --- 30
2 --- 40 4 --- 40
2 --- **
3 --- **
4 --- **
** --- **
** --- **
J'ai testé plusieur solution sans parvenir à un résultat probant.
Merci de votre aide
A voir également:
- Supprimer des cellules via macros
- Supprimer rond bleu whatsapp - Guide
- Supprimer page word - Guide
- Verrouiller des cellules excel - Guide
- Supprimer pub youtube - Accueil - Streaming
- Formule excel pour additionner plusieurs cellules - Guide
9 réponses
Bonjour Le Pingou,
Voici la macro que j'utilise pour supprimer les "**" mais lorsque que le test arrive sur des cellules comportant des nombres, la macro semble figer sur une case.
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
End If
Loop
Voici la macro que j'utilise pour supprimer les "**" mais lorsque que le test arrive sur des cellules comportant des nombres, la macro semble figer sur une case.
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
End If
Loop
RE Le Pingou,
j'ai trouver la solution à mon pb via la macro qui suivi. Elle est assez complexe alors si quelqu'un à une idée pour la simplifié, merci d'avance !
Do While Not (IsEmpty(ActiveCell))
A1:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
ElseIf Cells(N, ActiveCell.Column).Text <> "**" Then GoTo A2
End If
Loop
A2:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N + 1, ActiveCell.Column).Text = "**" Then
N = N + 1
GoTo A1
ElseIf Cells(N + 1, ActiveCell.Column) = "" Then
Exit Do
ElseIf (Abs(Cells(N, ActiveCell.Column) - Cells(N + 1, ActiveCell.Column))) < 2 Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
N = N - 1
End If
N = N + 1
Loop
ActiveCell.Offset(0, 1).Select
If Cells(6, 1) = 3 Then
N = 12
Else: N = 102
Cells(N, ActiveCell.Column).Select
End If
Loop
j'ai trouver la solution à mon pb via la macro qui suivi. Elle est assez complexe alors si quelqu'un à une idée pour la simplifié, merci d'avance !
Do While Not (IsEmpty(ActiveCell))
A1:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
ElseIf Cells(N, ActiveCell.Column).Text <> "**" Then GoTo A2
End If
Loop
A2:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N + 1, ActiveCell.Column).Text = "**" Then
N = N + 1
GoTo A1
ElseIf Cells(N + 1, ActiveCell.Column) = "" Then
Exit Do
ElseIf (Abs(Cells(N, ActiveCell.Column) - Cells(N + 1, ActiveCell.Column))) < 2 Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
N = N - 1
End If
N = N + 1
Loop
ActiveCell.Offset(0, 1).Select
If Cells(6, 1) = 3 Then
N = 12
Else: N = 102
Cells(N, ActiveCell.Column).Select
End If
Loop
Bonjour,
Merci pour les informations.
Pouvez-vous m'indiquer les lignes de code avant le Do While Not et celles après le Loop !
--
Salutations.
Le Pingou
Merci pour les informations.
Pouvez-vous m'indiquer les lignes de code avant le Do While Not et celles après le Loop !
--
Salutations.
Le Pingou
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonjour,
En attendant votre réponse au message précédent, essayez donc ce cette procédure.
Note : la procédure détermine le nombre de colonne selon les titres en première ligne.
En attendant votre réponse au message précédent, essayez donc ce cette procédure.
Note : la procédure détermine le nombre de colonne selon les titres en première ligne.
Sub supprimerdecaler()
Dim co As Long, li As Long, nbco As Long
Dim valpre
' récupérer nombre colonne
nbco = Cells(1, Columns.Count).End(xlToLeft).Column
' suppression astérisque et décaller vers haut
For co = 1 To nbco
For li = Cells(Rows.Count, co).End(xlUp).Row To 2 Step -1
If Cells(li, co) = "**" Then
Cells(li, co).Delete Shift:=xlUp
End If
Next li
' suppression doublon et décaller vers haut
valpre = ""
For li = Cells(Rows.Count, co).End(xlUp).Row To 2 Step -1
If Cells(li, co) = valpre Then
Cells(li, co).Delete Shift:=xlUp
End If
valpre = Cells(li, co)
Next li
Next co
End Sub
Merci de votre aide Le Pingou,
voici la fonction complète qui fonction très bien.
Celle que vous m'avez proposé précédemment ne semble pas fonctionner car le système me génère une erreur sur la valeur nbco et ensuite sur la formule Shift:=xlup.
Function Gestion()
If Cells(6, 1) = 3 Then
N = 12
Cells(21, 16) = "Gestion en cours"
Cells(21, 16).Interior.ColorIndex = 34
Else
N = 102
Cells(27, 16) = "Gestion en cours"
Cells(27, 16).Interior.ColorIndex = 34
End If
Application.ScreenUpdating = False
[r10].CurrentRegion.Select
Selection.NumberFormat = "0.000"
Cells(N, 18).Activate
Do While Not (IsEmpty(ActiveCell))
A1:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
ElseIf Cells(N, ActiveCell.Column).Text <> "**" Then GoTo A2
End If
Loop
A2:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N + 1, ActiveCell.Column).Text = "**" Then
N = N + 1
GoTo A1
ElseIf Cells(N + 1, ActiveCell.Column) = "" Then
Exit Do
ElseIf (Abs(Cells(N, ActiveCell.Column) - Cells(N + 1, ActiveCell.Column))) < 2 Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
N = N - 1
End If
N = N + 1
Loop
ActiveCell.Offset(0, 1).Select
If Cells(6, 1) = 3 Then
N = 12
Else: N = 102
Cells(N, ActiveCell.Column).Select
End If
Loop
If Cells(6, 1) = 3 Then
If Cells(18, 16) <> "" And N = 13 Then
Cells(21, 16) = "Gestion OK"
Cells(21, 16).Interior.ColorIndex = 35
Else
MsgBox "La troisième étape n'est pas validée"
Cells(6, 1) = Cells(6, 1) - 1
End If
End If
If Cells(6, 1) = 5 Then
If Cells(24, 16) <> "" And N = 103 Then
Cells(27, 16) = "Gestion OK"
Cells(27, 16).Interior.ColorIndex = 35
Else
MsgBox "La cinquième étape n'est pas validée"
Cells(6, 1) = Cells(6, 1) - 1
End If
End If
[A1].Select
End Function
voici la fonction complète qui fonction très bien.
Celle que vous m'avez proposé précédemment ne semble pas fonctionner car le système me génère une erreur sur la valeur nbco et ensuite sur la formule Shift:=xlup.
Function Gestion()
If Cells(6, 1) = 3 Then
N = 12
Cells(21, 16) = "Gestion en cours"
Cells(21, 16).Interior.ColorIndex = 34
Else
N = 102
Cells(27, 16) = "Gestion en cours"
Cells(27, 16).Interior.ColorIndex = 34
End If
Application.ScreenUpdating = False
[r10].CurrentRegion.Select
Selection.NumberFormat = "0.000"
Cells(N, 18).Activate
Do While Not (IsEmpty(ActiveCell))
A1:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N, ActiveCell.Column).Text = "**" Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
ElseIf Cells(N, ActiveCell.Column).Text <> "**" Then GoTo A2
End If
Loop
A2:
Do While Not (IsEmpty(ActiveCell))
Cells(N, ActiveCell.Column).Interior.ColorIndex = 35
If Cells(N + 1, ActiveCell.Column).Text = "**" Then
N = N + 1
GoTo A1
ElseIf Cells(N + 1, ActiveCell.Column) = "" Then
Exit Do
ElseIf (Abs(Cells(N, ActiveCell.Column) - Cells(N + 1, ActiveCell.Column))) < 2 Then
Cells(N, ActiveCell.Column).Delete shift:=xlUp
N = N - 1
End If
N = N + 1
Loop
ActiveCell.Offset(0, 1).Select
If Cells(6, 1) = 3 Then
N = 12
Else: N = 102
Cells(N, ActiveCell.Column).Select
End If
Loop
If Cells(6, 1) = 3 Then
If Cells(18, 16) <> "" And N = 13 Then
Cells(21, 16) = "Gestion OK"
Cells(21, 16).Interior.ColorIndex = 35
Else
MsgBox "La troisième étape n'est pas validée"
Cells(6, 1) = Cells(6, 1) - 1
End If
End If
If Cells(6, 1) = 5 Then
If Cells(24, 16) <> "" And N = 103 Then
Cells(27, 16) = "Gestion OK"
Cells(27, 16).Interior.ColorIndex = 35
Else
MsgBox "La cinquième étape n'est pas validée"
Cells(6, 1) = Cells(6, 1) - 1
End If
End If
[A1].Select
End Function
Bonjour,
Merci de l'information.
Je tiens à préciser que la procédure proposée a été testé sans produire de message d'erreur.
Vous aurez noté qu'elle se base sur :
Note : la procédure détermine le nombre de colonne selon les titres en première ligne
Si cela n'est pas le cas alors le nombre des colonnes du tableau de données ne peut pas être déterminé : d'où le message d'erreur.
De plus vous ne dite même pas qu'elle est ce message d'erreur c'est vraiment frustrant
Merci de l'information.
Je tiens à préciser que la procédure proposée a été testé sans produire de message d'erreur.
Vous aurez noté qu'elle se base sur :
Note : la procédure détermine le nombre de colonne selon les titres en première ligne
Si cela n'est pas le cas alors le nombre des colonnes du tableau de données ne peut pas être déterminé : d'où le message d'erreur.
De plus vous ne dite même pas qu'elle est ce message d'erreur c'est vraiment frustrant
bonsoir,
navré de ne pas donner de détails... je tenterai de corriger cela mais je me suis apperçu que je mettait le shift:=xlup à la ligne donc cela peut être une erreur de ma part. quant au nbco, je ne saisis pas trop le fonctionnement et surtout, la 1er case a tester n'est effectivement pas en ligne 1.
Merci encore pour l'aide.
navré de ne pas donner de détails... je tenterai de corriger cela mais je me suis apperçu que je mettait le shift:=xlup à la ligne donc cela peut être une erreur de ma part. quant au nbco, je ne saisis pas trop le fonctionnement et surtout, la 1er case a tester n'est effectivement pas en ligne 1.
Merci encore pour l'aide.