XL 2013 msgbox suppression même valeur dans 2 feuilles différentes

[jerome91]

Bonjour,
Je cherche à faire une macro qui :
Ouvre une msgbox qui demande "quelle valeur voulez-vous supprimer ?"
Si cette valeur est dans les onglets Feuil1 et Feuil2 alors la macro supprime toutes les lignes qui contiennent cette valeur dans les Feuil1 et Feuil2.
Pourriez-vous m'aider ?
Merci.
Jérôme

 

[job75]

Bonjour jerome91,

Voyez le fichier joint et le code de l'UserForm :

Private Sub ComboBox1_Click()
Dim x$, c As Range, sup As Range
If ComboBox1.ListIndex = -1 Then Exit Sub
x = UCase(ComboBox1)
With Feuil1 'CodeName
  For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    If UCase(c) = x Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
  Next
End With
sup.EntireRow.Delete
Set sup = Nothing
With Feuil2 'CodeName
  For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    If UCase(c) = x Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
  Next
End With
sup.EntireRow.Delete
ComboBox1.RemoveItem ComboBox1.ListIndex
ComboBox1 = "'" & x & "' a été supprimé"
Application.OnTime 1, "DerouleListe" 'macro dans Module1
End Sub

Private Sub UserForm_Initialize()
Dim d As Object, c As Range
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each c In Feuil1.Range("A1", Feuil1.Range("A" & Feuil1.Rows.Count).End(xlUp))
  If Application.CountIf(Feuil2.[A:A], c) Then d(c.Value) = ""
Next
If d.Count Then ComboBox1.List = d.keys Else ComboBox1.Clear
Application.OnTime 1, "DerouleListe" 'macro dans Module1
End Sub

A+

 

[job75]

Bonjour jerome91, le forum,

Ceci est beaucoup plus rapide s'il y a beaucoup de lignes à traiter :

Private Sub ComboBox1_Click()
Dim x$
If ComboBox1.ListIndex = -1 Then Exit Sub
x = UCase(ComboBox1)
With Feuil1.UsedRange.Resize(, 2) 'Feuil1 CodeName
  .Columns(2) = "=1/(RC[-1]<>""" & x & """)"
  .Columns(2) = .Columns(2).Value 'supprime les formules
  .Sort .Columns(2), xlAscending, Header:=xlNo 'tri pour accélérer
  .Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
End With
Feuil1.UsedRange.Columns(2) = ""
With Feuil2.UsedRange.Resize(, 2) 'Feuil2 CodeName
  .Columns(2) = "=1/(RC[-1]<>""" & x & """)"
  .Columns(2) = .Columns(2).Value 'supprime les formules
  .Sort .Columns(2), xlAscending, Header:=xlNo 'tri pour accélérer
  .Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
End With
Feuil2.UsedRange.Columns(2) = ""
ComboBox1.RemoveItem ComboBox1.ListIndex
ComboBox1 = x & " a été supprimé"
Application.OnTime 1, "DerouleListe" 'macro dans Module1
End Sub

Private Sub UserForm_Initialize()
Dim d1 As Object, d2 As Object, t, i&
Set d1 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
Set d2 = CreateObject("Scripting.Dictionary")
d2.CompareMode = vbTextCompare 'la casse est ignorée
t = Feuil1.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If Not IsEmpty(t(i, 1)) Then d1(t(i, 1)) = ""
Next
t = Feuil2.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If d1.exists(t(i, 1)) Then d2(t(i, 1)) = ""
Next
If d2.Count Then ComboBox1.List = d2.keys
Application.OnTime 1, "DerouleListe" 'macro dans Module1
End Sub

Fichier (2).

A+

 

[job75]

Re,

Pour tester j'ai dupliqué 1000 fois les lignes de Feuil1 et Feuil2 dans le fichier joint.

Avec les macros de la version (2) sur Win 10 - Excel 2013 :

- chargement en 0,11 seconde

- 1ère suppression en 0,25 seconde.

Si l'on fait la même chose avec la version (1) on obtient 92 secondes et 55 secondes...

A+

 

[jerome91]

Bonjour,
Merci beaucoup !
Je cherche à copier cette macro (supprimer(2).xlsm car au travail je n'ai pas Win10) dans le fichier joint mais je ne sais pas comment faire.
Pourrais-tu m'aider ?
Je ne sais pas comment on fait pour la déplacer d'un fichier à un autre.
Cette fois-ci les onglets Feuil1 et Feuil2 s'appellent Variables et Feuil1 (onglet masqué).
Le bouton "supprimer" est dans l'onglet Variables.
Merci.
Jérôme

 

[job75]

Bonsoir jerome91,

Comme quoi il faut présenter dès le début un fichier qui corresponde au fichier réel !!!

Pour la macro ComboBox1_Click on ne peut pas utiliser la solution (2) car elle fait un tri.

Par ailleurs les valeurs à supprimer sont maintenant des nombres, pas des textes.

Voici donc le code de l'UserForm dans le fichier joint :

Private Sub ComboBox1_Click()
Dim x, c As Range, sup As Range
If ComboBox1.ListIndex = -1 Then Exit Sub
x = Val(ComboBox1)
With Feuil2 'CodeName de la feuille "Variables"
  For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    If c = x Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
  Next
End With
sup.EntireRow.Delete
Set sup = Nothing
With Feuil4 'CodeName de la feuille "Feuil1"
  For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
    If c = x Then Set sup = Union(c, IIf(sup Is Nothing, c, sup))
  Next
End With
sup.EntireRow.Delete
ComboBox1.RemoveItem ComboBox1.ListIndex
ComboBox1 = "'" & x & "' a été supprimé"
Application.OnTime 1, "DerouleListe" 'macro dans Module3
End Sub

Private Sub UserForm_Initialize()
Dim d1 As Object, d2 As Object, t, i&
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
t = Feuil2.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If Not IsEmpty(t(i, 1)) Then d1(t(i, 1)) = ""
Next
t = Feuil4.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
  If d1.exists(t(i, 1)) Then d2(t(i, 1)) = ""
Next
If d2.Count Then ComboBox1.List = d2.keys
Application.OnTime 1, "DerouleListe" 'macro dans Module3
End Sub

A+

 

[jerome91]

Merci, dsl, je le serais pour la prochaine fois.
J'ai 2 questions :
1) comment fais-je pour voir "l'intérieur" de la macro ? Quand je fais développeur, macros, modifier, je ne vois pas le détail complètement comme dans la réponse. Je débute, excuse moi pour cette question qui peut paraître bête.
2) est-il possible de modifier la macro de telle façon à ce que dans l'onglet Variables, cellule (A,1), le chiffre prenne -1 quand je supprime une valeur à chaque fois ?
En effet quand je lance le bouton 2 ma macro ne va plus.
En effet, ce bouton 2 récupère les infos que l'utilisateur rajoute dans l'onglet CDC et s'insère à la suite dans les trois tableaux + fonction multiplication dans le dernier.
Merci.
Jérôme

 

[jerome91]

Merci, dsl, je le serais pour la prochaine fois.
J'ai 2 questions :
1) comment fais-je pour voir "l'intérieur" de la macro ? Quand je fais développeur, macros, modifier, je ne vois pas le détail complètement comme dans la réponse. Je débute, excuse moi pour cette question qui peut paraître bête.
2) est-il possible de modifier la macro de telle façon à ce que dans l'onglet Variables, cellule (A,1), le chiffre prenne -1 quand je supprime une valeur à chaque fois ?
En effet quand je lance le bouton 2 ma macro ne va plus.
En effet, ce bouton 2 récupère les infos que l'utilisateur rajoute dans l'onglet CDC et s'insère à la suite dans les trois tableaux + fonction multiplication dans le dernier.
Merci.
Jérôme

 

[job75]

Re,

Pour la question 2) je n'ai pas compris, pour mettre au point vos propres macros ouvrez une nouvelle discussion avec des questions précises.

Pour la question 1) Alt+F11 pour aller dans VBA.

En haut à gauche double-clic sur "Feuilles" puis clic droit sur "UserForm1" => Code.

A+

 

[jerome91]

C'est bon j'ai trouvé pour modifier ma macro initiale.
Encore merci beaucoup pour ton aide.
Bonne soirée.
Jérôme