XL 2010 Problème pour "soustraire" des éléments de colonne

[Auzingueur]

Bonjour à tous,

Je reviens aujourd'hui poser un nouveau problème :

J'ai deux colonnes (col1 et col2). J'aimerai (en VBA) que les éléments présents dans ma col1 soient retirés de ma col2 et que la plage de données définissant ma col2 soient révisée pour ne prendre en compte que la nouvelle colonne réduite.

Ci-joint un fichier exemple.
Par avance merci!

PS : Un problème que j'ai sur mon fichier est le temps de calcul, du coup si vous avez une solution permettant de ne pas rajouter trop de temps de calcul je suis preneur.

 

[job75]

Bonjour Auzingueur,

En utilisant des tableaux VBA c'est très rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, t, rest(), d As Object, i&, n&
Set r = Intersect([B:C], Me.UsedRange.EntireRow)
t = r 'matrice, plus rapide
ReDim rest(1 To UBound(t), 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
'---liste 1ère colonne sans doublon---
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then d(t(i, 1)) = ""
Next
'---remplissage du tableau rest---
For i = 1 To UBound(t)
  If t(i, 2) <> "" Then If Not d.exists(t(i, 2)) Then _
    n = n + 1: rest(n, 1) = t(i, 2)
Next
'---restitution---
Application.EnableEvents = False
If n Then [C1].Resize(n) = rest
[C1].Offset(n).Resize(Rows.Count - n) = ""
Application.EnableEvents = True
End Sub

Fichier joint.

A+

 

[Auzingueur]

Merci de ton aide, cela semble bien correspondre à ma demande, me reste juste à rajouter le rename de ma plage, mais je l'ai déjà fais dans une autre partie du fichier, cela ne devrais pas être trop compliqué.

 

[Auzingueur]

J'ai un petit problème avec l'utilisation du Intersect : mes colonnes n'étant pas B et C dans la réalité mais B et F sur deux feuilles différentes j'ai remplacé la ligne

Set r = Intersect([B:C], Me.UsedRange.EntireRow)

par

Set r = Intersect(Sheets("Contrainte SIMER").Range("B2:B" & Sheets("Contrainte SIMER").[B65536].End(3).Row, Sheets("Autorisation Produits Ligne3").Range("M3:M" & Sheets("Autorisations Produits Ligne3").[M65536].End(3).Row))

.

Contrainte SIMER et Autorisation Produits Ligne3 étant les feuilles sur lesquelles se trouvent mes 2 colonnes. J'ai aussi remplacé

[C1].Offset(n).Resize(Rows.Count - n) = ""

par

[M1].Offset(n).Resize(Rows.Count - n) = ""

J'ai cependant une erreur sur mon Set r (je ne maitrise pas vraiment la fonction intersect) ; j'ai vu qu'il ne fallait que des arguments qui soient des ranges :/ ... Mon erreur : erreur d'exécution '1004' : erreur définie par l'application ou par l'objet.

Si quelqu'un pourrai m'éclairer...

Merci!

 

[job75]

Re,

Avant toute autre modification, j'ai recopié la plage B2:C11 sur B2:C100001.

La macro s'exécute chez moi (Win10 - Excel 2013) en 0,5 seconde.

Vous voulez nommer la plage pour faire quoi ? A priori ce n'est pas nécessaire.

A+

 

[Auzingueur]

Sa l'est car cette plage est en fait une liste de produits positionnables sur un planning.

J'ai en fait une condition avant ce code, et si je rentre dans cette condition, la liste de produits (col1) ne pourra plus être positionné sur mon planning, je veux donc les enlever de ma plage (col2).

La maccro envoyée fonctionne bien, mais c'est mes modifications qui la font déconner, je ne comprend pas vraiment pourquoi :/

 

[job75]

Re,

Puisque vous n'êtes pas capable d'adapter, il fallait joindre un fichier qui corresponde à votre fichier réel.

Il est encore temps de le faire, en précisant bien ce que vous voulez obtenir.

A+

 

[Auzingueur]

Voici le fichier de tout a l'heure revu, qui correspond plus à mon problème, je vous fais perdre votre temps désolé :/

 

[job75]

Re,

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [D:D,G8:G10]) Is Nothing Then MAJ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F2]) Is Nothing Then MAJ
End Sub

Sub MAJ()
Dim w1 As Worksheet, w2 As Worksheet, P As Range, rest, t, d As Object, i&, n&
Set w1 = Feuil1: Set w2 = Feuil2 'CodeNames des feuilles
If Application.CountIf(w1.[G8:G10], w2.[F2]) = 0 Then Exit Sub
Set P = Intersect(w2.[M:M], w2.UsedRange.EntireRow)
rest = P.Resize(, 2) 'au moins 2 éléments
t = Intersect(w1.[D:E], w1.UsedRange.EntireRow) 'au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
'---liste 1ère colonne sans doublon---
For i = 1 To UBound(t)
  If t(i, 1) <> "" Then d(t(i, 1)) = ""
Next
'---remplissage du tableau rest---
For i = 1 To UBound(rest)
  If rest(i, 1) <> "" Then If Not d.exists(rest(i, 1)) Then _
    n = n + 1: rest(n, 1) = rest(i, 1)
Next
'---restitution---
If n Then P.Resize(n) = rest
If n > 2 Then P(3).Resize(n - 2).Name = "maplage" 'plage nommée
P(1).Offset(n).Resize(w2.Rows.Count - n - P.Row + 1).Delete xlUp
End Sub

Votre dernier fichier en retour.

A+

 

[job75]

Re,

Si l'on veut que la mise à jour se fasse aussi quand on modifie la colonne M en 2ème feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F2,M:M]) Is Nothing Then MAJ
End Sub

Sub MAJ()
Dim w1 As Worksheet, w2 As Worksheet, P As Range, rest, t, d As Object, i&, n&
Set w1 = Feuil1: Set w2 = Feuil2 'CodeNames des feuilles
Set P = Intersect(w2.[M:M], w2.UsedRange.EntireRow)
rest = P.Resize(, 2) 'au moins 2 éléments
t = Intersect(w1.[D:E], w1.UsedRange.EntireRow) 'au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
'---liste 1ère colonne sans doublon---
If Application.CountIf(w1.[G8:G10], w2.[F2]) Then
  For i = 1 To UBound(t)
    If t(i, 1) <> "" Then d(t(i, 1)) = ""
  Next
End If
'---remplissage du tableau rest---
For i = 1 To UBound(rest)
  If rest(i, 1) <> "" Then If Not d.exists(rest(i, 1)) Then _
    n = n + 1: rest(n, 1) = rest(i, 1)
Next
'---restitution---
Application.EnableEvents = False
If n Then P.Resize(n) = rest
If n > 2 Then P(3).Resize(n - 2).Name = "maplage" 'plage nommée
P(1).Offset(n).Resize(w2.Rows.Count - n - P.Row + 1).Delete xlUp
Application.EnableEvents = True
End Sub

Cela permet de toujours redéfinir "maplage".

Fichier (2).

A+

 

[Auzingueur]

Merci de votre aide, il y a du mieux dans le sens ou cela ne plante pas, et qu'en mettant des espions j'arrive a passer dans tout le code, rien n'est modifié cependant dans ma colonne M ou figure ma plage..

Je m’interroge sur le ligne suivante :

t = Intersect(w1.[D:E], w1.UsedRange.EntireRow)

La colonne E étant vide, cela e me retourne-t-il pas un t constamment vide?

EDIT : My bad, j'ai trouvé d'où viens mon problème, le dico est rempli d'éléments, mais pas les bons du coup il n'y a aucune correspondance avec ma liste M et du coup ca supprime rien, je vais essayer de modifier le code pour m'en sortir, merci!

 

[job75]

Bonjour Auzingueur,

La colonne E ne sert qu'à donner 2 colonnes au tableau t (qui doit avoir au moins 2 éléments).

On n'utilise pas du tout les valeurs qui peuvent s'y trouver.

A+

 

[Auzingueur]

D'accord je comprend.

J'ai finalement réussi a le faire fonctionner a peu près, j'ai juste un problème sur le Application.CounIf : qu'est ce que cela signifie lorsqu'il vaux 0?

 

[job75]

Re,

Application.CountIf c'est la fonction Excel NB.SI, elle permet de tester le contenu de la cellule F2.

A+

 

[Auzingueur]

Dac, ça fonctionne, merci de votre aide, bonne continuation, je repasserai surement dans l'avenir en cas de problème!