XL 2010 Récupérer certaines d'1 tableau dans 1 autre

cathodique · 24 Janvier 2021

Bonjour,

En ce dimanche, j'ai voulu améliorer ma manipulation des tableaux. Mais, je m’emmêle les "pinceaux" comme on dit. Je m'en remets à vous pour me venir en aide.
Je récupère dans un tableau certains colonnes de la feuille. Je voudrai extraire de ce tableau dans un autre tableau certaines lignes remplissant les conditions suivantes:
If Tb(i, 3) <> "A" Or Tb(i, 3) <> "C" Then
Là, je suis perdu.

VB:

Option Explicit

Sub Tableau()
    Dim Tb1(), Tb(), i As Integer, j As Byte, n As Integer, Tb2()

    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        Tb = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 5, 6))
    End With
'à partir d'ici je suis perdu
    n = 0
    For i = LBound(Tb) To UBound(Tb)
        For j = 1 To 4
            If Tb(i, 3) <> "A" Or Tb(i, 3) <> "C" Then
                  n = n + 1
                ReDim Preserve Tb1(1 To UBound(Tb), 1 To n)
                Tb1(i, n) = Tb(i, j)
            End If
        Next j
    Next i
'    Tb2 = Application.Transpose(Tb1)
Stop
End Sub

En vous remerciant par avance.

Bon dimanche.

cp4 · 25 Janvier 2021

Bonjour Cathodique, Patrick, Sylvanu,

D'après ce que j'ai compris du fil, un essai

VB:

Option Explicit

Sub Tableaux()
    Dim Tb(), Tb1(), Tb2(), i%, j%, n%
    DL = Application.Max(Range("H65500").End(xlUp).Row, 2)
    Range("H2:K" & DL).ClearContents
    Application.ScreenUpdating = False
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        Tb = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 5, 6))
    End With
    '''''''''''''''''''''''''''''''
    For i = 1 To UBound(Tb)
        If Tb(i, 3) = "B" Or Tb(i, 3) = "D" Then
            n = n + 1
            ReDim Preserve Tb1(1 To 4, 1 To n)
            For j = 1 To 4
                Tb1(j, n) = Tb(i, j)
            Next j...

sylvanu · 24 Janvier 2021

Bonjour Cathodique,
Un essai en PJ avec :

VB:

Sub Tableau()
    Dim Tb(), Tb1(), Tb2(), i%, j%, n%
    Range("H2:K" & Range("H65500").End(xlUp).Row).ClearContents
    Application.ScreenUpdating = False
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        Tb = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 5, 6))
    End With
    n = 0
    ReDim Tb1(3, UBound(Tb))
    For i = LBound(Tb) To UBound(Tb)
        If Tb(i, 3) <> "A" And Tb(i, 3) <> "C" Then
            For j = 1 To 4
                Tb1(j - 1, n) = Tb(i, j)
            Next j
            n = n + 1
        End If
    Next i
    Tb2 = Application.Transpose(Tb1)
    Range("$H$2").Resize(UBound(Tb2, 1), UBound(Tb2, 2)) = Tb2
End Sub

Les erreurs sont au niveau de la gestion d'index et de l'imbrication For/If.
C'est Si .... Alors de 1 à 4, et non le contraire.

cathodique · 24 Janvier 2021

sylvanu à dit:

Bonjour Cathodique,
Un essai en PJ avec :

VB:

Sub Tableau()
    Dim Tb(), Tb1(), Tb2(), i%, j%, n%
    Range("H2:K" & Range("H65500").End(xlUp).Row).ClearContents
    Application.ScreenUpdating = False
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        Tb = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 5, 6))
    End With
    n = 0
    ReDim Tb1(3, UBound(Tb))
    For i = LBound(Tb) To UBound(Tb)
        If Tb(i, 3) <> "A" And Tb(i, 3) <> "C" Then
            For j = 1 To 4
                Tb1(j - 1, n) = Tb(i, j)
            Next j
            n = n + 1
        End If
    Next i
    Tb2 = Application.Transpose(Tb1)
    Range("$H$2").Resize(UBound(Tb2, 1), UBound(Tb2, 2)) = Tb2
End Sub

Les erreurs sont au niveau de la gestion d'index et de l'imbrication For/If.
C'est Si .... Alors de 1 à 4, et non le contraire.

Bonjour Sylvanu ,

Je te remercie beaucoup. Je n'arrive pas vraiment à bien manipuler ces satanés tableaux.
J'ai mis sur la feuille le résultat à obtenir alors que ce n'est pas mon objectif. En fait je dois encore manipuler le tableau obtenu pour des calculs.

Ton code donne le bon résultat sur la feuille. En fait le tableau Tb1 à beaucoup de colonnes lignes vides et par transposition Tb2 à autant de lignes vides. Ils ont les mêmes dimensions que le tableau de départ.
Il est vrai que je ne l'ai pas précisé. J'avais cru que c'était explicite en mettant Redim Preserve Tb1.

Je voudrai qu'à chaque tour de boucle faire un redim preserve et alimenter le tableau au fur et à mesure pour qu'au final il n'y ait pas de lignes vides dans le tableau final.

En tout cas encore merci, d'avoir d’emmêlé mes pinceaux.

sylvanu · 24 Janvier 2021

Il suffit d'exclure les lignes vides.
( j'ai pris ici ligne vide si vide en A et vide en E ) en modifiant :

VB:

If Tb(i, 1) <> "" And Tb(i, 3) <> "" And Tb(i, 3) <> "A" And Tb(i, 3) <> "C" Then

patricktoulon · 24 Janvier 2021

re
bonjour a tous
ouais ben moi juste en passant je ferais plutôt comme ça
c'est pas la peine de créer un tablo d'union de colonne pour le reconstruire ligne par ligne dans une 2 et 3 eme boucle
il faut faire un array(2 dim variable tableau de X lignes sur 1 colonne) d'index de ligne
et c'est tout

VB:

Option Explicit

Sub Tableau()
    Dim Tb, I&, tablo, it, lignes
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        tablo = .Value
        For I = 1 To UBound(tablo)
            If tablo(I, 5) = "A" Or tablo(I, 5) = "C" Then it = it & " " & I
        Next
        lignes = Application.Transpose(Split(Trim(it), " "))
        Tb = Application.Index(.Value, lignes, Array(1, 2, 5, 6))
    End With
    [H2].Resize(UBound(Tb), UBound(Tb, 2)) = Tb
End Sub

cathodique · 24 Janvier 2021

Bonsoir Sylvanu, PatrickToulon ,

Excusez mon retard, j'ai la manie de sortir et laisser mon ordi allumé.

@sylvanu : Je n'ai encore testé ta dernière mais je te fais confiance. Le résultat sera au RDV.

@patricktoulon : Tu as très bien fait de passer et me faire profiter de ton expérience (DVP avec qui nous nous sommes tous fâchés).

Avec tous mes remerciements. J'espère m'en sortir pour la suite.

patricktoulon · 24 Janvier 2021

de rien cathodique
perso je suis fâché avec personne je mélange pas les torchons et les le PQ c'est tout

cathodique · 24 Janvier 2021

sylvanu à dit:
Il suffit d'exclure les lignes vides.
( j'ai pris ici ligne vide si vide en A et vide en E ) en modifiant :

VB:

If Tb(i, 1) <> "" And Tb(i, 3) <> "" And Tb(i, 3) <> "A" And Tb(i, 3) <> "C" Then

Re, Sylvanu
Excuses moi, je me suis mal fait comprendre. Tb(i,1) n'est jamais vide, données provenant de la feuille.
une image vaut mieux qu'un long discours. J'ai mis un stop et utilisé la fenêtre espion.
Voici une partie du tableau, tu comprendras mieux ainsi.

C'est ce que je voudrais éviter un tableau avec des lignes vides (de 16 à 32 les lignes sont vides).
Merci. Bonne soirée.

patricktoulon · 24 Janvier 2021

re
perso je pige pas le raisonnement "exclure les lignes vides" avec ton tb2(i,3)
puisque de tout façon vide est différent de "A" ou de "C"
ajoute tout simplement la condition vide dans la colonne 1
c'est tout

VB:

Sub Tableau()
    Dim Tb, I&, tablo, it, lignes
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        tablo = .Value
        For I = 1 To UBound(tablo)
            If (tablo(I, 5) = "A" Or tablo(I, 5) = "C") And tablo(I, 1) <> "" Then it = it & " " & I
        Next
        lignes = Application.Transpose(Split(Trim(it), " "))
        Tb = Application.Index(.Value, lignes, Array(1, 2, 5, 6))
    End With
    [H2].Resize(UBound(Tb), UBound(Tb, 2)) = Tb
End Sub

sylvanu · 24 Janvier 2021

Re,
Désolé je n'avais pas compris le post #3.

cathodique · 24 Janvier 2021

patricktoulon à dit:

re
perso je pige pas le raisonnement "exclure les lignes vides" avec ton tb2(i,3)
puisque de tout façon vide est différent de "A" ou de "C"
ajoute tout simplement la condition vide dans la colonne 1
c'est tout

VB:

Sub Tableau()
    Dim Tb, I&, tablo, it, lignes
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        tablo = .Value
        For I = 1 To UBound(tablo)
            If (tablo(I, 5) = "A" Or tablo(I, 5) = "C") And tablo(I, 1) <> "" Then it = it & " " & I
        Next
        lignes = Application.Transpose(Split(Trim(it), " "))
        Tb = Application.Index(.Value, lignes, Array(1, 2, 5, 6))
    End With
    [H2].Resize(UBound(Tb), UBound(Tb, 2)) = Tb
End Sub

version propre

VB:

Option Explicit

Sub Tableau()
    Dim Tb, I&, tablo, it, lignes
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        tablo = .Value
        For I = 1 To UBound(tablo)
            If (tablo(I, 5) = "A" Or tablo(I, 5) = "C") And tablo(i,1)<>"" Then it = it & " " & I
        Next
        lignes = Application.Transpose(Split(Trim(it), " "))
        Tb = Application.Index(.Value, lignes, Array(1, 2, 5, 6))
    End With
    [H2].Resize(UBound(Tb), UBound(Tb, 2)) = Tb
End Sub

Re Patrick,
Je m'adressais à Sylvanu dans mon précédent post. Je lui ai répondu par rapport à sa proposition.
En faisant juste une adaptation de cette ligne

VB:

If tablo(I, 5) = "B" Or tablo(I, 5) = "D" Then it = it & " " & I

Ton code est tout bon.

Comme mentionné, dans mon premier post c'est pour m'améliorer que j'ai ouvert cette discussion.
De plus, je suis un peu têtu, je veux bien aller au bout de mes idées et bien souvent, je déchante car je n'ai pas toutes les compétences et connaissances en VBA.

Je te le redis ton code est bon. Je me demande seulement comment rester sur mon idée initiale; à savoir à chaque tour de boucle Faire un Redim Preserve et alimenter le tableau au fur et à mesure.

Si ce n'est pas possible, je serai fixé une fois pour toute. J'espère avoir été plus clair.

Encore merci.

Bonne soirée.

patricktoulon · 24 Janvier 2021

re
si c'est possible mais le redim preserve est transposé a la base
et re transposition l'ors de l'injection dans la feuille
pour la simple et seule raison c'est que redim preserve ne peut redimer que la derniere dimension d'une variable tableau

par exemple ceci c'est pas possible
for x= 1 to 10
for y = 1 to 10
redim preserve tbl (1 to x, 1 to y)
next
next

c'est pour cela qu'on inverse lignes/colonne dans une boucle car ton truc a toujours 4 colonnes
donc on redim preserve tb (1 to4,1 to x) dans une double boucle imbriquée

Attention tout de même la transposition a ses limites en terme d'item quand on a pas une certaine mise a jour

cathodique · 24 Janvier 2021

sylvanu à dit:
Re,
Désolé je n'avais pas compris le post #3.

@sylvanu : je te remercie beaucoup pour ta patience et ton aide.

cathodique · 24 Janvier 2021

patricktoulon à dit:
re
si c'est possible mais le redim preserve est transposé a la base
et re transposition l'ors de l'injection dans la feuille
pour la simple et seule raison c'est que redim preserve ne peut redimer que la derniere dimension d'une variable tableau

par exemple ceci c'est pas possible
for x= 1 to 10
for y = 1 to 10
redim preserve tbl (1 to x, 1 to y)
next
next

c'est pour cela qu'on inverse lignes/colonne dans une boucle car ton truc a toujours 4 colonnes
donc on redim preserve tb (1 to y,1 to 4) dans une double boucle imbriquée

Attention tout de même la transposition a ses limites en terme d'item quand on a pas une certaine mise a jour

@patricktoulon : Tous mes remerciements pour tes explications, ton aide, ta patience et ton code.
Toutes ces boucles et toutes ces transpositions me donnent le tournis.

C'est bon pour aujourd'hui, je reprendrais demain mes investigations.

Bonne soirée.

cp4 · 25 Janvier 2021

Bonjour Cathodique, Patrick, Sylvanu,

D'après ce que j'ai compris du fil, un essai

VB:

Option Explicit

Sub Tableaux()
    Dim Tb(), Tb1(), Tb2(), i%, j%, n%
    DL = Application.Max(Range("H65500").End(xlUp).Row, 2)
    Range("H2:K" & DL).ClearContents
    Application.ScreenUpdating = False
    With Feuil1.Range("A2:F" & Cells(Rows.Count, 1).End(xlUp).Row)
        Tb = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 5, 6))
    End With
    '''''''''''''''''''''''''''''''
    For i = 1 To UBound(Tb)
        If Tb(i, 3) = "B" Or Tb(i, 3) = "D" Then
            n = n + 1
            ReDim Preserve Tb1(1 To 4, 1 To n)
            For j = 1 To 4
                Tb1(j, n) = Tb(i, j)
            Next j
        End If
    Next i
    Tb12 = Application.Transpose(Tb1)

    Range("$H$2").Resize(UBound(Tb12, 1), UBound(Tb12, 2)) = Tb12
End Sub

Bonne journée.

XL 2010 Récupérer certaines d'1 tableau dans 1 autre

cathodique

XLDnaute Barbatruc

Pièces jointes

cp4

sylvanu

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Discussions similaires