XL 2010 Supprimer ligne tableau 1 dimension

cp4 · 25 Avril 2020

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?

VB:

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 · 25 Avril 2020

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.

VB:

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 · 25 Avril 2020

job75 à dit:

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

VB:

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 · 26 Avril 2020

Bonjour cp4, le forum,

Corrigez votre code, ceci ne va pas :

VB:

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

Bonne journée.

cp4 · 26 Avril 2020

job75 à dit:
Bonjour cp4, le forum,

Corrigez votre code, ceci ne va pas :

VB:

[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

VB:

[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 · 26 Avril 2020

cp4 à dit:
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 · 26 Avril 2020

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.

VB:

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

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

cp4 · 26 Avril 2020

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

Ok, merci.

laurent950 · 26 Avril 2020

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.

VB:

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 · 26 Avril 2020

laurent950 à dit:

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.

VB:

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 · 26 Avril 2020

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 · 26 Avril 2020

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 · 26 Avril 2020

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 · 26 Avril 2020

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

laurent950 · 26 Avril 2020

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

VB:

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 · 26 Avril 2020

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

XL 2010 Supprimer ligne tableau 1 dimension

cp4

XLDnaute Barbatruc

Pièces jointes

cp4

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

laurent950

XLDnaute Accro

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

laurent950

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Discussions similaires