Tableau

re le forum

y a t il un code simple qui ne passe pas par le remplissage de toutes les cellules pour faire un tableau PT ( mais sans l'écrire sur une feuille , juste pour le stocker) 3 colonnes fabriqué à partir des colonnes 1 , 5 et 7 d'un tableau à 10 colonnes GT (même nombre de lignes.

Style mais complètement faux:

PT.Column(1)=GT.Column(1)

PT.Column(2)=GT.Column(5)

PT.Column(3)=GT.Column(7)

Merci pour vos lumières

Séb

Sans avoir essayé ... si tu ne sélectionne à la souris que les 3 colonnes qui t'intéressent, ensuite copier/coller dans un nouvel onglet (avec ou sans liaisons), cela ne suffit-il pas ?

Bonjour,

Je ne suis pas sûr d'avoir bien interprété ta demande Par code VBA ? :

Sub Test()

    Feuil2.Columns(1).Value = Feuil1.Columns(1).Value
    Feuil2.Columns(2).Value = Feuil1.Columns(5).Value
    Feuil2.Columns(3).Value = Feuil1.Columns(7).Value

End Sub

Hervé.

Bonjour à tous,

Ta plage à partir de A1, écriture de la variable a en Feuil2

Sub Tableau()
Dim a
    With Sheets("Feuil1").Range("A1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(1, 5, 7))
    End With
   'Restitution
    With Sheets("Feuil2").Range("A1").Resize(UBound(a, 1), UBound(a, 2))
        .Value = a
    End With
End Sub

klin89

Bonjour à tous

merci pour votre aide

Me suis mal exprimé en effet, je ne veux pas recopier les colonnes mais juste créer un tableau

extrait du premier afin d'utiliser un code que j'ai trouvé qui permet de faire une recherche sur un mot dans tout le tableau.

(le petit que j'aurais extrait du grand)

Je pense donc que Klin89 doit m'avoir apporté la solution

Par contre, je n'ai besoin que de ça si j'ai bien compris le code

Sub Tableau()

Dim PT

With Sheets("Feuil1").Range("A1").CurrentRegion

PT = Application.Index(.Value, Evaluate("row(1:" & _

.Rows.Count & ")"), Array(1, 5, 7))

End With

End Sub

Mais question:

existe-il un truc du genre:

Sub Tableau()

Dim PG 'Grand tableau d'où il faut extraire les colonnes 1,5,7

Dim PT 'petit tableau extrait du premier

PG = 'tableau de A1 à J&Ws.Range("B" & Rows.Count).End(xlUp).Row ?????

PT = Application.Index(.Value, Evaluate("row(1:" & _ .Rows.Count & ")"), Array(1, 5, 7))

End Sub

En corrigeant toutes les erreurs bien sûr

merci encore pour votre aide

Re Sarl54,

Sans exemple concret, on y arrivera pas

Pour parvenir à tes fins, il faut combiner, Application.Index, Application.Transpose voire utiliser la fonction de tableau Filter

Il y a beaucoup de syntaxes possibles, tout dépend sur quoi on travaille

Sub essai()
    a = Sheets("Feuil1").[A1:D6] '6 lignes 4 colonnes
    b = Application.Index(a, Application.Transpose(Array(1, 2, 3, 5)), Array(2, 3))
    With Sheets("Feuil1").Range("G1").Resize(UBound(b, 1), UBound(b, 2))
        .Value = b ' 4 lignes 2 colonnes que l'on a choisi
    End With
End Sub

Si tu veux jouer avec les variables tableau, tu risques le mal de crâne

klin89

Bonjour,

PT.Column(1)=GT.Column(1)

PT.Column(3)=GT.Column(7)

Solution 1

Simple & rapide (Utiliser les Arrays emboités )

Dim a(1 To 3)
a(1) = Application.Transpose([A1:A10])
a(2) = Application.Transpose([C1:C10])
a(3) = Application.Transpose([F1:F10])
lig = 2:   col = 3:  MsgBox a(col)(lig)

Solution 2:

Moins rapide

 Set Rng = [A2:F8]
 b = Application.Index(Rng, Evaluate("Row(1:" & Rng.Rows.Count & ")"), Array(1, 3, 6))
 [M2].Resize(UBound(b), UBound(b, 2)) = b

Soution 3:

2 fois + rapide que la solution 2

Sub FiltreColonnes()
  a = [A2].Resize(4, 20) ' tableau a()
  b = FiltreArrayCol(a, Array(1, 3, 6, 7)) ' on prend les colonnes 1, 3, 6, 7
  [A11].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Function FiltreArrayCol(tableau, ColResult)
  Dim b()
  ReDim b(LBound(tableau) To UBound(tableau), 1 To UBound(ColResult) - LBound(ColResult) + 1)
  decal = 1 - LBound(ColResult)
  For i = LBound(tableau, 1) To UBound(tableau, 1)
    For c = LBound(ColResult) To UBound(ColResult)
      b(i, c + decal) = tableau(i, ColResult(c))
    Next c
  Next i
  FiltreArrayCol = b
End Function

Ceuzin

merci beaucoup

ca me convient bien