Variable tableau qui ne se transpose pas

Version imprimable

Bonjour à vous

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

Code:

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:

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

09/10/2022, 13h29
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.
09/10/2022, 14h08
Mr l'Ashanti

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

Code:

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 ?
09/10/2022, 14h59
Mr l'Ashanti

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

Re bonjour ici

Code:

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

10/10/2022, 10h51
Mr l'Ashanti

1 pièce(s) jointe(s)

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?

Bonjour,

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

Code:

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+

11/10/2022, 07h47
Mr l'Ashanti

1 pièce(s) jointe(s)

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.Pièce jointe 627022
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:

.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.
11/10/2022, 08h07
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+
11/10/2022, 09h03
Mr l'Ashanti

merci
mais le fichier depasse 2Mo
11/10/2022, 09h14
Invité

Re,

Et bien déposez un fichier anonymisé sur une plateforme comme GrosFichiers.com

Et partagez le lien ici ;)

A+
11/10/2022, 09h28
Mr l'Ashanti

j'ai copié le fichier et vidé le contenu pour ne rester que la seule feuille. mais la taille est toujours en 2Mo. j'ai l'impression que le fichier même à un problème de mémoire:pleure:
11/10/2022, 09h41
Mr l'Ashanti

2 pièce(s) jointe(s)

Voici le fichier.... une pour la base de données et l'autre pour l'userform.
lorsque j'ai supprimé définitivement la feuille qui comportait les codes d'activation, le fichier s'est déchargé littéralement.

Après plusieurs test, j'ai constaté que si j'augmente le nombre qui est après Counter, j'obtiens une ligne suivante. J'ai donc conclure que si je parcours la variable tableau j'aurai le résultat escompté.
Le premier code que j'ai reçu de l'intervention marche correctement, mais ce code que je vais poster est fonction de mon application.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Set Plage = .ListObjects(1).DataBodyRange    
NbLigne = Plage.Rows.Count    
For NumLigne = 1 To NbLigne       
 If Plage.Cells(NumLigne, "F") Like Clé Then          
  Counter = Counter + 1           
 ReDim Preserve MonTableau(6, Counter)           
 For k = UBound(MonTableau, 1) To UBound(MonTableau, 1)          
  j = UBound(MonTableau, 1)                
For Col = 2 To 6                    
MonTableau(Col - 2, Counter - 1) = Plage.Cells(NumLigne, Col)                
Next            
ReDim Preserve MonTableau2(1, Counter)            MonTableau2(0, Counter - 1) = Plage.Cells(NumLigne, "N") & " ans"            
Next        
End If    
Next
Set Plage = Nothing
End With
With Ws    
.Visible = -1   
 .Select    
.Range(Cells(12, "D"), Cells(Counter + k + j - 2, "H")) = Application.Transpose(MonTableau) 'transposer le tableau sur la feuille    
.Range(Cells(12, "I"), Cells(Counter + k + j - 2, 9)) = Application.Transpose(MonTableau2)