Discussion :

[Mr l'Ashanti]

Bonjour à vous

j'ai un problème sur la compréhension de ma variable tableau. j'utilisais ce code mais ça chargeait lentement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 Counter = 0
    Clé = TextBox1
    Set ws = Workbooks("HL School Management.xlsm").Sheets("Test")
    'If Not ws.ListObjects(1).DataBodyRange Is Nothing Then ws.ListObjects(1).DataBodyRange.Delete
    With Workbooks("HLSM DataBase.xlsm").Sheets("Base élèves")
        For Xlignes = 7 To .Cells(Rows.Count, "F").End(xlUp).Row
            If .Cells(Xlignes, "F") Like Clé Then
                Counter = Counter + 1
             For col=2 to 6
                ws.Cells(Counter + 11, Col + 2) = .Cells(Xlignes, Col)
                ws.Cells(Counter + 11, "I") = .Cells(Xlignes, "N") & " ans"
             Next
            End If
        Next
     End with

j'ai décidé de passer par la variable tableau mais ma feuille ne reçoit pas la recherche des données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 Counter = 0
    Clé = TextBox1
    Set ws = Workbooks("HL School Management.xlsm").Sheets("Test")
    'If Not ws.ListObjects(1).DataBodyRange Is Nothing Then ws.ListObjects(1).DataBodyRange.Delete
    With Workbooks("HLSM DataBase.xlsm").Sheets("Base élèves")
        For Xlignes = 7 To .Cells(Rows.Count, "F").End(xlUp).Row
            If .Cells(Xlignes, "F") Like Clé Then
                Counter = Counter + 1
                ReDim Preserve Tablo(6, Counter)
                For Col = 2 To 6
                Tablo(Col, Counter) = .Cells(Xlignes, Col)
                Next
            End If
        Next
        ws.Cells(Counter + 11, Col + 2) = Tablo
End with

merci de m'aider

[Philippe Tulliez]

Bonjour,
Pour exporter une variable tableau dans une feuille excel, vous devez définir la plage complète (par exemple A2:H100) et plutôt qu'utiliser une boucle pour créer votre second tableau suivant critère, il est possible d'utiliser la fonction Filter pour construire ce tableau en une seule instruction

A lire éventuellement Utiliser les variables tableaux en VBA Excel

[EDIT]
J'ai écris un peu trop vite en évoquant la fonction Filter qui ne peut filtrer qu'une table à une dimension ce qui semble ne pas être votre cas et de plus j'ai cru que vous aviez chargé la plage complète dans un premier tableau ce qui n'est pas le cas.

Ceci étant dit, pour faire ce type de travail j'utiliserais plutôt Power Query ou la méthode AdvancedFilter de l'objet Range (filtres avancé d'excel). En VBA c'est une ligne de code après avoir définit la zone des données, celle des critères et celle d'exportation.

[Mr l'Ashanti]

Merci pour la promptitude
En suivant vos instructions, j'ai ou écrire ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Ws.Range(Cells(2,"A"),Cells(Counter,Col))=Application.Transpose(Tablo)

Ce qui fonctionne bien.
En regardant dans mon code, il y a une deuxième colonne qui se trouve hors des 6premieres colonnes donc se trouvant à la colonne I.
Comment l'ajouter à la première pour qu'on puisse avoir un tableau ?

[Mr l'Ashanti]

J'ai résolu le problème en créant un deuxième tableau. Et ça marche.
Merci pour l'aide

[Mr l'Ashanti]

Re bonjour ici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Option Base 1
 
Dim Tablo(), Tablo2(), Xlignes As Integer, rep As String, Col As Byte, ws As Worksheet
Application.ScreenUpdating = False
 
If TextBox1 <> "" Then
Select Case TextBox1
Case "CP1"
    Counter = 0
    Set ws = Workbooks("HLSM DataBase.xlsm").Sheets("Fiche CP1")
    If Not ws.ListObjects(1).DataBodyRange Is Nothing Then ws.ListObjects(1).DataBodyRange.Delete 'si le tableau est non vide alors on le vide
 
    With Workbooks("HLSM DataBase.xlsm").Sheets("Base élèves")
        For Xlignes = 7 To .Cells(Rows.Count, "F").End(xlUp).Row 'boucle sur les lignes
            If .Cells(Xlignes, "F") Like TextBox1 Then 'recherche
                Counter = Counter + 1 'incrémenter la solution de la recherche
                ReDim Preserve Tablo(6, Counter) 'redimensionner le tableau
                For Col = 2 To 6 'boucle sur les colonnes
                    Tablo(Col, Counter) = .Cells(Xlignes, Col) 'mettre la valeur de la recherche dans le tableau
                Next
                ReDim Preserve Tablo2(1, Counter)
                    Tablo2(1, Counter) = .Cells(Xlignes, "N") & " ans"
            End If
        Next
        ws.Range(Cells(12, "B"), Cells(Counter, Col)) = Application.Transpose(Tablo) 'transposer le tableau sur la feuille
        ws.Range(Cells(12, "H"), Cells(Counter, 8)) = Application.Transpose(Tablo2)
  End With

le code fonctionne correctement.
mais le problème est que la recherche s'arrête en plein milieu. pourtant quand je l'évalue, le counter prend le nombre total d'éléments trouvés or à la transposition il s'arréte au numéro 21 si le nombre d'occurences dépasse les 21.
j'ai essayé de passer par la listbox, la filtrer et la transposer sur la feuille et là encore pareil. toujours 21.
une aide vraiment svp
merci

[Mr l'Ashanti]

je poste le fichier pour que j'aie une explication sur la transposition à moitié. j'ai essayé sur une autre feuille et c'est la meme chose. quel est le problème au juste?

[Invité]

Bonjour,

Il y a certainement plus optimisé, mais voici le code corrigé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub CommandButton1_Click()  Dim Tablo()
  Dim Counter As Byte, Clé As String, Col As Byte
  Dim NbLigne As Long, NumLigne As Long, Plage As Range
 
 
  If Not Sheet2.ListObjects(1).DataBodyRange Is Nothing Then Sheet2.ListObjects(1).DataBodyRange.Delete
 
 
  Clé = Sheet2.Range("filtre")
  Counter = 0
 
 
  With Sheet1
    Set Plage = .ListObjects(1).DataBodyRange
    NbLigne = Plage.Rows.Count
    For NumLigne = 1 To NbLigne
      If Plage.Cells(NumLigne, "E") Like Clé Then
        Counter = Counter + 1
        ReDim Preserve Tablo(5, Counter)
        For Col = 1 To 5
          Tablo(Col, Counter - 1) = Plage.Cells(NumLigne, Col)
        Next
      End If
    Next
    Set Plage = Nothing
  End With
 
 
  With Sheet2
    .Range(Cells(2, "A"), Cells(Counter + 1, Col)) = Application.Transpose(Tablo)
  End With
End Sub

A+

[Mr l'Ashanti]

Merci pour le coup de pouce. j'ai testé le code et ça fonctionne correctement.
j'ai par ensuite adapté le code à mon application et la transposition n'est pas correcte. lorsque j'applique le code dans un nouveau classeur, le filtre et la transposition se font aisément mais sur la feuille de mon appli non.
sur l'image, le nombre d'occurrences trouvées est de 32 par contre je n'ai sur la feuille de l'application que 22.
et quand j'augmente au fur et à mesure le nombre de valeur au compteur (counter+counter)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 .Range(Cells(12, "C"), Cells(Counter + counter, Col)) = Application.Transpose(MonTableau)

, tout le résultat s'affiche mais il ajoute par ailleurs #N/A à la suite du tableau parce que le nombre d' éléments trouvés n'existent pas dans cette plage.
j'ai testé toutes les éventualités mais je ne trouve pas l'erreur.

[Invité]

Re,

Désolé, mais si vous ne donnez pas le vrai fichier comment voulez-vous être aidé 🤔

Le code fonctionne correctement, si vous devez l'adapter, faites le correctement

A+