Supprimer ligne d'un Array multidimensionel

Bonjour à tous et à toutes,

Comme j'ai un peu de mal avec les tableaux et que j'ai les neurones encore en vacances

J'aimerai trouver le code pour supprimer certaines lignes d'un tableau multidimensionnel

Ci-joint un fichier avec le début d'un code et ma demande

Si quelqu'un pouvait m'aider ce dont je ne doute pas

Cordialement.

Bonjour Bruno,

pour ça , je me suis fait une p'tite routine toute simple :

Sub Ote_elem(Tablo, num As Integer)
Dim i As Integer
    For i = num To UBound(Tablo) - 1
        Tablo(i) = Tablo(i + 1)
    Next i
    ReDim Preserve Tablo(i - 1)
End Sub

L'appel est simple call Ote_elem (Nom_du_tableau, numéro_de_ligne)

Pierre

Bonjour,

une proposition pour un tableau à 2 dimensions, mais je me demande si dans ce cas-ci travailler via un tableau est plus efficace que de travailler avec un filtre sur la feuille excel (filtrer les valeurs à supprimer, puis supprimer les lignes sélectionnées).

Option Explicit

Sub Test()
    Call DetailSup("Initial", "T008")
End Sub

Sub DetailSup(sSht As String, IdNum As String)
    Dim DLig As Long, Ind As Long, j As Long, k As Long
    Dim MonTab() As Variant
    ' Avec la feuille
    With Sheets("Détail")
        ' Trouver la dernière ligne
        DLig = .Range("B" & Rows.Count).End(xlUp).Row
        ' Définir le tableau
        MonTab = .Range("A2:K" & DLig).Value
        ' Pour chaque ligne
        DLig = UBound(MonTab) 'dlig contient le numéro de la dernière ligne utile du tableau, ne plus utiliser (ubound,1)
        For Ind = LBound(MonTab) To DLig
            ' Si le statut est le bon et l'id est le bon
            If MonTab(Ind, 1) = sSht And MonTab(Ind, 2) = IdNum Then
                'proposition 1, on copie la dernière ligne du tableau sur la ligne à supprimer
                For j = LBound(MonTab, 2) To UBound(MonTab, 2)
                    MonTab(Ind, j) = MonTab(DLig, j)
                    MonTab(DLig, j) = ""
                Next j
                DLig = DLig - 1
                ' proposition 2, on décale tout le tableau d'une ligne
                For k = Ind + 1 To DLig
                 For j = LBound(MonTab, 2) To UBound(MonTab, 2)
                  MonTab(k - 1, j) = MonTab(k, j)
                 Next j
                Next k
                For j = LBound(MonTab, 2) To UBound(MonTab, 2)
                  MonTab(DLig, j) = ""
                 Next j
                 DLig = DLig - 1
            End If
        Next Ind
    End With
    On Error GoTo 0
End Sub

Bonjour,

intéressant pour moi qui maitrise très mal les tableaux ....

une partie du code sur laquelle je teste et je demande si pas possible de faire autrement ???

si la condition est respectée, j'efface dans le tableau de la colonne 1 à la 11 mais une fois revenu dans la feuille

avec cette instruction: [Q2].Resize(UBound(MonTab), UBound(MonTab, 2)) = MonTab

j'ai des lignes vides...

For Ind = LBound(MonTab) To UBound(MonTab)

' Si le statut est le bon et l'id est le bon

If MonTab(Ind, 1) = sSht And MonTab(Ind, 2) = IdNum Then

' mettre dans autre tableau ????

' effacer données de la colonne 1 à la 11

For ZZ = 1 To 11 ' effacement des données si

MonTab(Ind, ZZ) = ""

Next

ReDim Preserve MonTab(1 To UBound(MonTab), 1 To 11)

' ???

End If

Next Ind

Salut PierreP56

Merci pour ton code

mais celui-ci ne concerne que les tableaux à une dimension, ce qui n'est pas mon cas

A+


Salut h2so4

Merci également pour ton code,

mais mon tableau comporte plus de colonne

h2so4 a écrit :

Bonjour,

je me demande si dans ce cas-ci travailler via un tableau est plus efficace que de travailler avec un filtre sur la feuille excel (filtrer les valeurs à supprimer, puis supprimer les lignes sélectionnées).

C'est effectivement ce que je me suis dis et certainement ce que je vais faire

Au plaisir


Salut Patrick1957

[quote="patrick1957"]Bonjour,

intéressant pour moi qui maitrise très mal les tableaux ....

une partie du code sur laquelle je teste et je demande si pas possible de faire autrement ???

si la condition est respectée, j'efface dans le tableau de la colonne 1 à la 11 mais une fois revenu dans la feuille

avec cette instruction: [Q2].Resize(UBound(MonTab), UBound(MonTab, 2)) = MonTab

j'ai des lignes vides...[/quote]

Je pense qu'il vaut mieux faire comme l'idée de h2so4

1) filtrer les lignes du tableaux selon X critères

2) supprimer les lignes visibles

A+

Bonjour Bruno,

perso, en partant de ton exemple, j'arrive à recopier à droite l'ensemble du tableau amputé de "Initial", "T008" mais avec des lignes vierges ....là où justement se trouvaient les lignes "T008"

Je cherche à savoir comment ne plus avoir ces lignes vides au moment du transfert du tableau vers la feuille

Bonjour

Un exercice sur les tableaux c'est toujours intéressant

C'est vrai que filtrer et supprimer les lignes est plus simple à faire (je le suppose), mais inconvénient (ou avantage) la base initiale n'est plus la

Donc ma petite contribution

Bonjour à toi Oh GRAND MANITOU

1 seul mot : PARFAIT

Banzai64 a écrit :

Bonjour

Un exercice sur les tableaux c'est toujours intéressant

C'est vrai que filtrer et supprimer les lignes est plus simple à faire (je le suppose), mais inconvénient (ou avantage) la base initiale n'est plus la

Donc ma petite contribution

Comme je ne veux pas garder la base initiale, ça ne me pose pas de problème

mais je vais utiliser ton code certainement plus sûr que celui ci-dessous que j'ai concocté

Sub Test()
  Call DetailSup("Initial", "T016")
End Sub

Sub DetailSup(sSht As String, IdNum As String)
  Dim PLig As Long, DLig As Long, Plage As Range
  ' Avec la feuille
  With Sheets("Détail")
    ' Trouver la dernière ligne
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Filter les lignes selons les critères
    .Range("A1:K" & DLig).AutoFilter Field:=1, Criteria1:=sSht
    .Range("A1:K" & DLig).AutoFilter Field:=2, Criteria1:=IdNum
    ' Trouver la dernière ligne
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    ' Trouver la première ligne visible
    On Error Resume Next
    Set Plage = .Range("_filterdatabase").Offset(1).Resize(, 1)
    Set Plage = Plage.Resize(Plage.Count - 1).SpecialCells(xlCellTypeVisible)
    PLig = 0: PLig = Plage.Row
    On Error GoTo 0
    ' Supprimer
    If DLig > PLig Then
      .Rows(PLig & ":" & DLig).Delete Shift:=xlUp
    End If
    ' Effacer le filtre
    .Range("A1:K1").AutoFilter
  End With
End Sub

En tout cas merci et au plaisir

re,

je trouve ceci plus rapide et intéressant , ne serait ce que pour comprendre un peu mieux la manipulation des tableaux

Merci

Bonsoir le forum,

Salut Bruno

Je n'ai pas testé sur un grand nombres de lignes : à voir

Sub Supprime_Lignes_Array()
Dim a, b(), i As Long, lig As String
    With Sheets(1).Cells(1).CurrentRegion
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 2) <> "T008" Then lig = lig & "_" & i
        Next
        b = Application.Index(a, Application.Transpose(Split(Mid(lig, 2), "_")), Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11))
        'Restitution à côté du tableau initial
        With .Offset(, .Columns.Count + 2)
            .Resize(UBound(b, 1), UBound(b, 2)) = b
        End With
    End With
End Sub

klin89

Bonjour,

Option Explicit

Sub Test()
  Call DetailSup("Initial", "T008")
End Sub
Sub DetailSup(sSht As String, IdNum As String)
  Dim DLig As Long, Ind As Long
  Dim MonTab() As Variant
  With Sheets("Détail")
    DLig = .Range("B" & Rows.Count).End(xlUp).Row
    MonTab = .Range("A2:K" & DLig).Value
  End With
  '-----
  MonTab = FiltreArraySupLignes(MonTab, 2, IdNum)
  [M2].Resize(UBound(MonTab), UBound(MonTab, 2)) = MonTab
End Sub

Function FiltreArraySupLignes(Tbl, col, cle)
   Dim i, n
   Dim tmp(): ReDim tmp(1 To UBound(Tbl))
   For i = LBound(Tbl) To UBound(Tbl)
     If Tbl(i, col) <> cle Then n = n + 1: tmp(n) = i
   Next
   ReDim Preserve tmp(1 To n)
   FiltreArraySupLignes = Application.Index(Tbl, Application.Transpose(tmp), _
      Application.Transpose(Evaluate("Row(1:" & UBound(Tbl, 2) & ")")))
End Function

Ceuzin

Bonjour le fil

@Klin89

Pas testé dans mon fichier car il faut adapter le code

A+

>Ce code ne fonctionne que pour un tableau à 1 dimension, or j'ai 11 colonnes

Cette fonction fonctionne sur les tableaux à 2 dimensions!

Ceuzin


>Ce code ne fonctionne que pour un tableau à 1 dimension, or j'ai 11 colonnes

Cette fonction fonctionne sur les tableaux à 2 dimensions!

Ceuzin

sans titre

Bonjour,

simple et rapide Klin

bravo

Re,

@Ceuzin,

Désolé effectivement le fichier de base que tu as donné fonctionne très bien

C'est en voulant l'adapter au mien que ça ne passait plus

Par contre je ne comprends pas vraiment comment ça fonctionne

A+

>Par contre je ne comprends pas vraiment comment ça fonctionne

Utilise la fonction Index(champ;Vecteur Ligne;Vecteur Colonne)

http://boisgontierjacques.free.fr/pages_site/fonctionindex.htm#VecteurLigne

http://boisgontierjacques.free.fr/pages_site/tableaux.htm#TransCol

La suppression de lignes classique est sensiblement plus rapide: (0,08s au lieu de 0,22s pour un Array de 10.000 lignes et 4 colonnes)

http://boisgontierjacques.free.fr/fichiers/Cellules/FonctionSelectionTableau.xls

Ceuzin

Rechercher des sujets similaires à "supprimer ligne array multidimensionel"