XL 2010 Supprimer ligne tableau 1 dimension

[cp4]

Bonjour,

Je sèche sur un problème. Je me suis inspiré d'un exemple de Boisgontier pour supprimer d'un tableau 2 dimensions des lignes suivants une clé.
J'ai rectifié le code pour l'utiliser avec un tableau à une dimension. Cependant, le code plante si c'est le premier item qu'on souhaite supprimer.
Pour les autres le code fonctionne correctement. Auriez-vous une explication, une solution?

Option Explicit

Sub supLigne()
   Dim choix(), i As Integer, j As Integer, n As Integer, clé
   choix = [a1].CurrentRegion.Value
   clé = [e1]
   n = 0
   For i = LBound(choix) To UBound(choix)
      If choix(i, 1) <> clé Then n = n + 1
   Next i
   j = 0
   Dim T(): ReDim T(1 To n, 1 To 1)
   For i = LBound(choix) To UBound(choix)
      If choix(i, 1) <> clé Then j = j + 1
      T(j, 1) = choix(i, 1)
   Next i
   [c1].Resize(UBound(T)) = T
End Sub

En vous remerciant par avance.

 

[cp4]

Sachant que la colonne ne compotera pas doublon (ou plutôt le tableau) donc l'utilisation d'un dictionnaire est plus pratique (enfin à mon avis). J'édite le code qui pourrait servir.

Sub choix()   ' à exploiter
   Dim choix(), i As Integer, d1 As Object
   Set d1 = CreateObject("scripting.dictionary")
   asupprimer = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).row)
   choix = [A1].CurrentRegion.Value
   For i = 1 To UBound(choix)
      d1(choix(i, 1)) = ""
   Next i
   For i = 1 To UBound(asupprimer)
      d1.Remove (asupprimer(i, 1))
   Next i
   [C:C].ClearContents
   [C1].Resize(d1.Count) = Application.Transpose(d1.keys)
End Sub

Bonne soirée.

edit: on s'est croisé merci beaucoup Job75

 

[cp4]

S'il y a plusieurs clés en E1 E2 E3 etc on peut utiliser le Dictionary :

Sub supLigneClésMultiples()
Dim d As Object, clé As Range, choix, i&, n&
'---liste des clés à supprimer---
Set d = CreateObject("Scripting.Dictionary")
For Each clé In [E1].CurrentRegion
    d(clé.Value) = ""
Next
'---traitement du tableau---
choix = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(choix)
      If Not d.exists(choix(i, 1)) Then n = n + 1: choix(n, 1) = choix(i, 1)
Next i
'---restitution---
[C:C].ClearContents
[C1].Resize(n) = choix
End Sub

La macro est très rapide.

Merci beaucoup Job75, nos messages se sont croisés.
En réalité, Les valeurs mises en colonne E sont issues d'une Listbox. C'est pour simplifié mon problème que j'ai utilisé des données sur une feuille.
J'espère réussir à adapter à mon formulaire.
Tous mes remerciements.

 

[job75]

Bonjour cp4, le forum,

Corrigez votre code, ceci ne va pas :

[C1].Resize(d1.Count) = d1.keys

Bonne journée.

 

[cp4]

Bonjour cp4, le forum,

Corrigez votre code, ceci ne va pas :

[C1].Resize(d1.Count) = d1.keys

Bonne journée.

Bonjour Job75, le Forum,

Je n'ai pas compris ce qui ne va pas avec la ligne que tu me signales

[C1].Resize(d1.Count) = d1.keys

Stp, pourrais-tu m'expliquer ce qui ne va pas. J'avais pourtant testé avant d'éditer le code.

Merci.

edit: @job75 je viens de comprendre. En effet, il fallait transposer. Ce n'est pas encore assimilé ces histoires de resize et transpose. Aurais-tu une astuce pour ne plus se mélanger les pinceaux?J'avais aussi ouvert une discussion pour cette histoire.

 

[job75]

Aurais-tu une astuce pour ne plus se mélanger les pinceaux?J'avais aussi ouvert une discussion pour cette histoire.

Il suffit de se rappeler que le Dictionary est une matrice à 1 dimension, donc un vecteur ligne.

 

[cp4]

Bonjour Laurent950,
Merci pour ton code. Mais je crois bien que tu as des soucis comme moi.
Comme me l'avait signalé Job75() la dernière ligne est fausse.

   [c1].Resize(UBound(T)) = Application.Transpose(T)

C'est ce qu'il faut. Bon dimanche.

 

[cp4]

Il suffit de se rappeler que le Dictionary est une matrice à 1 dimension, donc un vecteur ligne.

Ok, merci.

 

[laurent950]

Bonjour,
J'ai voulu corrigé et j'ai effacer le précédent poste. par contre je comprend pas pourquoi cela fonctionne pas ?
Option Base 1
le tableau 1D commence a 0 mais le tableaux choix commence à 1 donc "Option Base 1" pour commencer tous les tableaux a 1.

Sub SupLigneBis()
Option Base 1
Option Explicit
Sub SupLigneBis()
   Dim choix() As Variant, i As Integer, j As Integer, clé As Variant
    choix = [a1].CurrentRegion.Value
    clé = [e2]
   Dim T() As Variant, Té() As Variant, n As Integer
   n = 1 ' UBound(T) = 1 et N = 1  Le tableau T commence à 1 grasse a Option base 1
   ReDim T(n)
   For i = LBound(choix) To UBound(choix)
      If choix(i, 1) <> clé Then
        T(UBound(T)) = choix(i, 1)
        ReDim Preserve T(UBound(T) + 1)
        If i = UBound(choix) Then
            ReDim Preserve T(UBound(T) - 1)
        End If
    End If
   Next i
   [B:B].ClearContents
   [c3:c25].ClearContents
   [B1].Resize(UBound(T)) = Application.Transpose(T)
   [C1].Resize(LBound(T), UBound(T)) = T
   End Sub

[/code]

 

[cp4]

Bonjour,
J'ai voulu corrigé et j'ai effacer le précédent poste. par contre je comprend pas pourquoi cela fonctionne pas ?
Option Base 1
le tableau 1D commence a 0 mais le tableaux choix commence à 1 donc "Option Base 1" pour commencer tous les tableaux a 1.

Sub SupLigneBis()
Option Base 1
Option Explicit
Sub SupLigneBis()
   Dim choix() As Variant, i As Integer, j As Integer, clé As Variant
    choix = [a1].CurrentRegion.Value
    clé = [e2]
   Dim T() As Variant, Té() As Variant, n As Integer
   n = 1 ' UBound(T) = 1 et N = 1  Le tableau T commence à 1 grasse a Option base 1
   ReDim T(n)
   For i = LBound(choix) To UBound(choix)
      If choix(i, 1) <> clé Then
        T(UBound(T)) = choix(i, 1)
        ReDim Preserve T(UBound(T) + 1)
        If i = UBound(choix) Then
            ReDim Preserve T(UBound(T) - 1)
        End If
    End If
   Next i
   [B:B].ClearContents
   [c3:c25].ClearContents
   [B1].Resize(UBound(T)) = Application.Transpose(T)
   [C1].Resize(LBound(T), UBound(T)) = T
   End Sub

[/code]

Désolé Laurent de ne pouvoir te donner d'explication.
Comme on a déjà répondu à mon fil. Je te conseille d'ouvrir le tien, tu auras plus de chance d'avoir une explication.

Bon dimanche.

 

[patricktoulon]

bonjour
@laurent
Dim choix() As Variant, i As Integer, j As Integer, clé As Variant
choix = [a1].CurrentRegion.Value

il n'y a pas quelque qui te gène ?????

et là aussi il n'y a pas quelque chose qui te gène (il y a même 2 méprise)

[C1].Resize(LBound(T), UBound(T)) = T

 

[laurent950]

Bonjour Patrick,
Si il y a quelque chose qui me géne
Dim choix As Range, i As Integer, j As Integer, clé As Variant
Set choix = Range([a1].CurrentRegion.Address)
Ou
Dim choix() As Variant, i As Integer, j As Integer, clé As Variant
choix = [a1].CurrentRegion.Value

 

[patricktoulon]

re
depuis quand on dimensionne à 0 une variable tableau qui va recevoir le .value d'un range ????
une variable prévue à cet effet ne se dimensionne pas

et pour la 2d erreur qui accompagne la 3eme t'a compris ???

 

[cp4]

Salut patricktoulon, laurent950, le forum,
@patricktoulon et @laurent950
Déjà que j'ai du mal à assimiler. Pouvez-vous svp être plus explicite? merci.

 

[laurent950]

re,
Tu as un Œil de lynx Patrick voila j'ai trouvé tous seul la correction.

Donc :
Option Base 1 / pas besoin car ReDim T(0)
Dim choix As Variant / pas besoin de Choix()
Est comme T commence à 0 à la fin
[B1].Resize(UBound(T) + 1) = Application.Transpose(T)
[C1].Resize(LBound(T) + 1, UBound(T) + 1) = T
Car LBound(T) = 0 est il ne peux pas commencer à 0 mais a 1

Option Explicit
Sub SupLigneBis()
   Dim choix As Variant, i As Integer, j As Integer, clé As Variant
    choix = [a1].CurrentRegion.Value
    clé = [e2]
   Dim T() As Variant, Té() As Variant, n As Integer
   ReDim T(0)
   For i = LBound(choix) To UBound(choix)
      If choix(i, 1) <> clé Then
        T(UBound(T)) = choix(i, 1)
        ReDim Preserve T(UBound(T) + 1)
        If i = UBound(choix) Then
            ReDim Preserve T(UBound(T) - 1)
        End If
    End If
   Next i
   [B:B].ClearContents
   [c3:c25].ClearContents
   [B1].Resize(UBound(T) + 1) = Application.Transpose(T)
   [C1].Resize(LBound(T) + 1, UBound(T) + 1) = T
   End Sub

 

[patricktoulon]

re
bonjour cp4
les penthzes servent a dimentionner un tableau

dim tablo() 'dimentionne un tableau vide
si je fait apres
tablo= [a1].CurrentRegion.Value
c'est comme si j'essayais de le redimensionner donc walouh !!!!

laurent950
Ah!! à la bonne heure
le tout c'est de décider au depart si on travaille en base 1 ou 0
apres perso pour evter des meprises
puisque je veux etaler mon tableau T sur une ligne je fait
comme [C1] fait deja 1!! ligne je ne resize que les colonnes
[C1].Resize( , UBound(T) + 1) = T
c'est tout de suite plus clair pour le lecteur