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)
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"
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+
Bonjour,
simple et rapide Klin
bravo
Re,
@Ceuzin,
Désolé
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