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

[cathodique]

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.

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.

 

[sylvanu]

Bonjour Cathodique,
Un essai en PJ avec :

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]

Bonjour Cathodique,
Un essai en PJ avec :

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]

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

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

 

[patricktoulon]

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

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]

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]

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

 

[cathodique]

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

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]

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

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]

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

 

[cathodique]

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

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

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

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]

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]

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

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

 

[cathodique]

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]

Bonjour Cathodique, Patrick, Sylvanu,

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

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.