XL 2010 Récupérer données d'un Array 2D dans 1D

cp4 · 29 Octobre 2020

Bonjour ,

Je manipule basiquement les Tableaux VBA. En voulant aider, je suis confronté au problème suivant.
J'ai puisé le code ci-dessous sur le site de Boisgontier. Ce dernier, récupère des données en 2D.
Or, je ne souhaite récupère qu'un seule colonne soit un tableau 1D (enfin si j'ai retenu quelque chose des Arrays).
J'ai essayé sans y parvenir.

VB:

Sub filtre()
  Set f = Sheets("bd")
  Tbl1 = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
 ville = "Paris"
  n = 0
  Dim Tbl2()
  For i = 1 To UBound(Tbl1)
    If Tbl1(i, 3) = ville Then
      n = n + 1
      ReDim Preserve Tbl2(1 To UBound(Tbl1, 2), 1 To n)
      For k = 1 To UBound(Tbl1, 2): Tbl2(k, n) = Tbl1(i, k): Next k
    End If
  Next i
  Tbl3 = Application.Transpose(Tbl2)
 f.[G2].Resize(UBound(Tbl3), UBound(Tbl3, 2)) = Tbl3
End Sub

En fait, c'est pour alimenter une listbox. En effet, pour la variable "ville", je voudrais récupérer la colonne D et quelques fois le tableau Tbl est vide.
Et, dans ce cas afficher dans la listbox "pas de correspondance trouvée".

En vous remerciant par avance.

ps: Désolé de ne pouvoir joindre le fichier.

patricktoulon · 29 Octobre 2020

bonjour cp4
et ben dit donc
que nous soyons sur la même longueur d'onde
selon ce que je vois dans ton code (voir si j'ai bien compris ton intention)
tu veux récupérer dans la colonne 2 de ton tableau les lignes correspondant a ville dans la colonne 3

et tu veux ca en array 1D

donc deja t'a tout faut ici

VB:

 For k = 1 To UBound(Tbl1, 2): Tbl2(k, n) = Tbl1(i, k): Next k

car le tableau que tu crée est un tableau a 2 dimension(x lignes/1 colonne)
un tableau à 1D il n'y a pas de ubound(t,2) c'est ubound(t) tout court

mais revenons a nos moutons
comment récupérer une colonne d'un tableau 2D dans un array 1D

et bien mon ami tu a des outils pour ça
exemple ici on va recuper la colonne 2 de ta variable tableau

Tbl1 = f.Range("A2" & f.[A65000].End(xlUp).Row).Value
'abracadra
with application:monarray1D=.transpose(.index(Tbl1,0,2)):end with
'testons pour voir
msgbox monarray(1)'good!!!
'msgbox monarray(1,1)' a ben mince alors

tu n'a plus qu'a tester en débloquant le 2d essai qui devrait te planter car monarray est vraiment à 1D

c'est bon ca rentre

cp4 · 29 Octobre 2020

patricktoulon à dit:
bonjour cp4
et ben dit donc
que nous soyons sur la même longueur d'onde
selon ce que je vois dans ton code (voir si j'ai bien compris ton intention)
tu veux récupérer dans la colonne 2 de ton tableau les lignes correspondant a ville dans la colonne 3

et tu veux ca en array 1D

donc deja t'a tout faut ici

VB:

For k = 1 To UBound(Tbl1, 2): Tbl2(k, n) = Tbl1(i, k): Next k

car le tableau que tu crée est un tableau a 2 dimension(x lignes/1 colonne)
un tableau à 1D il n'y a pas de ubound(t,2) c'est ubound(t) tout court

mais revenons a nos moutons
comment récupérer une colonne d'un tableau 2D dans un array 1D

et bien mon ami tu a des outils pour ça
exemple ici on va recuper la colonne 2 de ta variable tableau

Tbl1 = f.Range("A2" & f.[A65000].End(xlUp).Row).Value
'abracadra
with application:monarray1D=.transpose(.index(Tbl1,0,2)):end with
'testons pour voir
msgbox monarray(1)'good!!!
'msgbox monarray(1,1)' a ben mince alors

tu n'a plus qu'a tester en débloquant le 2d essai qui devrait te planter car monarray est vraiment à 1D

c'est bon ca rentre

Bonjour PatrickToulon ,

Je savais bien que j'avais tout faux. il te fallait juste retenir que j'ai bien dis que le code a été récupéré du site de Boisgontier (ce fichier). Et que, je ne pouvais pas joindre le véritable fichier car je n'ai pas reçu l'autorisation du demandeur.
Mais revenons au code, je voulais apprendre sur la base du code posté redimensionner Tbl2.
Là, tu me proposes une autre approche. Je t'en remercie mais qui ne répond pas à mes attentes.

Je pense avoir trouvé (ci-dessous juste la boucle)

VB:

For i = 1 To UBound(Tbl1)
      If Tbl1(i, 3) = ville Then
         n = n + 1
         ReDim Preserve Tbl2(1 To n)
         For k = 1 To UBound(Tbl1, 2): Tbl2(n) = Tbl1(i, k): Next k
      End If
   Next i

Cependant, je dois effectuer des tests pour m'assurer que ça renvoie bien tous les résultats escomptés.

Encore merci pour ta pertinente réponse.
Bonne journée.

patricktoulon · 29 Octobre 2020

cp4 à dit:
VB:

For i = 1 To UBound(Tbl1) If Tbl1(i, 3) = ville Then n = n + 1 ReDim Preserve Tbl2(1 To n) For k = 1 To UBound(Tbl1, 2): Tbl2(n) = Tbl1(i, k): Next k End If Next i

Cependant, je dois effectuer des tests pour m'assurer que ça renvoie bien tous

désolé mais avec ce code tu récupère la dernière ligne COMPLÈTE contenant ville dans la colonne 3 de tbl1 dans un array 1D

c'est bien ça que tu voulais faire????

cp4 · 29 Octobre 2020

patricktoulon à dit:
désolé mais avec ce code tu récupère la dernière ligne COMPLÈTE contenant ville dans la colonne 3 de tbl1 dans un array 1D

c'est bien ça que tu voulais faire????

Pas vraiment. En fait je m'inspirais du code de Boisgontier (#1) pour trouver une solution.
Le code que je voudrais monter se résume ainsi:
Récupérer dans Listbox3 les lignes correspondant à l'item sélectionné dans la Listbox2 (code ci-dessous)

VB:

Private Sub ListBox2_Change()
   Dim j As Byte, ff As Worksheet, bd2, i As Integer, n As Integer, Tbl()
   Set ff = Sheets("session")
   bd2 = ff.Range("A2:C" & ff.[A65000].End(xlUp).Row)
   If Me.ListBox2.ListIndex = -1 Then Exit Sub

   Me.ListBox3.Clear
   selection = ListBox2.List(ListBox2.ListIndex, 0)

   For i = LBound(bd2) To UBound(bd2)
      If bd2(i, 1) = selection Then
         n = n + 1
         ReDim Preserve Tbl(1 To n)
         For j = 1 To UBound(bd2, 2): Tbl(n) = bd2(i, j): Next j
      End If
   Next i
   Debug.Print n
   If n <> 0 Then
      Me.ListBox3.List = Tbl
   Else
      Me.ListBox3.AddItem "pas trouvé"
   End If

End Sub

J'espère que c'est beaucoup plus clair.

patricktoulon · 29 Octobre 2020

re
ben non c'est pas clair
dis moi en français ce que tu veux vraiment garder du tbl1

laurent950 · 29 Octobre 2020

Bonsoir,
C'est peux être cela :

VB:

Sub filtre()
  Set f = Sheets("bd")
' Tbl1 = tableau 2D (bd)
  Tbl1 = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  ville = "Paris"
  n = 0
' Tbl2 = tableau 2D (Ligne corespond à la ville Paris: Nom/Age/Ville/Date)
  Dim Tbl2()
' Tbl2Bis = tableau 2D (1 colonne par n Ligne corespond à la ville Paris: Ville)
  Dim Tbl2Bis()
' Tbl4 = tableau 1D  (Colonne corespond à la ville Paris: Ville)
  Dim Tbl4()
  For i = LBound(Tbl1, 1) To UBound(Tbl1, 1) ' Boucle Ligne
    If Tbl1(i, 3) = ville Then ' Ligne i colonne 3
      n = n + 1
' Tbl2 = tableau 2D (4 Colonnes par n Lignes)
      ReDim Preserve Tbl2(LBound(Tbl1, 2) To UBound(Tbl1, 2), LBound(Tbl1, 1) To n)
        For k = LBound(Tbl1, 2) To UBound(Tbl1, 2)
            Tbl2(k, n) = Tbl1(i, k)
        Next k
' Tbl2Bis = tableau 2D (1 Colonnes par n Lignes)
      ReDim Preserve Tbl2Bis(LBound(Tbl1, 2) To LBound(Tbl1, 2), LBound(Tbl1, 1) To n)
        Tbl2Bis(1, n) = Tbl1(i, 3)
' Tbl4 = tableau 1D
        ReDim Preserve Tbl4(n - 1)
            Tbl4(n - 1) = Tbl1(i, 3)
    End If
  Next i
' 1)
  Tbl3 = Application.Transpose(Tbl2)
  f.[G2].Resize(UBound(Tbl3, 1), UBound(Tbl3, 2)) = Tbl3
' 2)
f.[Q2].Resize(UBound(Tbl4) + 1) = Tbl4
' 3)
Tbl2Bis = Application.Transpose(Tbl2Bis)
f.[R2].Resize(UBound(Tbl2Bis, 1), UBound(Tbl2Bis, 2)) = Tbl2Bis
End Sub

Récupérer données d'un Array 2D dans 1D

VB:

Sub filtre()
  Set f = Sheets("bd")
  Tbl1 = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  ville = "Paris"
  Dim Tbl2()
  ReDim Tbl2(0)
  For i = LBound(Tbl1, 1) To UBound(Tbl1, 1)
    If Tbl1(i, 3) = ville Then
        Tbl2(UBound(Tbl2)) = Tbl1(i, 3)
        ReDim Preserve Tbl2(UBound(Tbl2) + 1)
    End If
  Next i
  ReDim Preserve Tbl2(UBound(Tbl2) - 1)
  f.[G2].Resize(UBound(Tbl2) + 1) = Application.Transpose(Tbl2)
End Sub

patricktoulon · 29 Octobre 2020

re
salut laurent

laurent950 · 29 Octobre 2020

Salut Patrick

cp4 · 29 Octobre 2020

Bonsoir Laurent950, PatrickToulon,

Merci pour votre aide. Pour ne pas faire perdre votre temps. Je mets en suspend cette discussion.
En effet, pour le moment je suis un peu débordé. De plus, J'ai puisé un code de Boisgontier que je voulais adapter à un userform.
Dés que j'aurai un moment, je monterai un fichier se rapportant exactement au problème.

Avec mes remerciements anticipés.

Bonne soirée.

cp4 · 30 Octobre 2020

laurent950 à dit:

Bonsoir,
C'est peux être cela :

VB:

Sub filtre()
  Set f = Sheets("bd")
' Tbl1 = tableau 2D (bd)
  Tbl1 = f.Range("A2:D" & f.[A65000].End(xlUp).Row).Value
  ville = "Paris"
  n = 0
' Tbl2 = tableau 2D (Ligne corespond à la ville Paris: Nom/Age/Ville/Date)
  Dim Tbl2()
' Tbl2Bis = tableau 2D (1 colonne par n Ligne corespond à la ville Paris: Ville)
  Dim Tbl2Bis()
' Tbl4 = tableau 1D  (Colonne corespond à la ville Paris: Ville)
  Dim Tbl4()
  For i = LBound(Tbl1, 1) To UBound(Tbl1, 1) ' Boucle Ligne
    If Tbl1(i, 3) = ville Then ' Ligne i colonne 3
      n = n + 1
' Tbl2 = tableau 2D (4 Colonnes par n Lignes)
      ReDim Preserve Tbl2(LBound(Tbl1, 2) To UBound(Tbl1, 2), LBound(Tbl1, 1) To n)
        For k = LBound(Tbl1, 2) To UBound(Tbl1, 2)
            Tbl2(k, n) = Tbl1(i, k)
        Next k
' Tbl2Bis = tableau 2D (1 Colonnes par n Lignes)
      ReDim Preserve Tbl2Bis(LBound(Tbl1, 2) To LBound(Tbl1, 2), LBound(Tbl1, 1) To n)
        Tbl2Bis(1, n) = Tbl1(i, 3)
' Tbl4 = tableau 1D
        ReDim Preserve Tbl4(n - 1)
            Tbl4(n - 1) = Tbl1(i, 3)
    End If
  Next i
' 1)
  Tbl3 = Application.Transpose(Tbl2)
  f.[G2].Resize(UBound(Tbl3, 1), UBound(Tbl3, 2)) = Tbl3
' 2)
f.[Q2].Resize(UBound(Tbl4) + 1) = Tbl4
' 3)
Tbl2Bis = Application.Transpose(Tbl2Bis)
f.[R2].Resize(UBound(Tbl2Bis, 1), UBound(Tbl2Bis, 2)) = Tbl2Bis
End Sub

Bonsoir Laurent950, PatrickToulon ,

@laurent950 : ça répond bien à ma question. Je prendrai le temps d'étudier tes lignes de code à tête reposée car en ce moment je n'ai pas beaucoup de temps (travaux).

@patricktoulon : de ta bouche je la prends du bon côté. Ma langue maternelle est le Français.

Merci à vous deux. Bonne soirée.

patricktoulon · 30 Octobre 2020

re
si tu a le temps donne nous un exemple en xlx avec le départ et le résultat
juste quelques lignes

cp4 · 30 Octobre 2020

patricktoulon à dit:
re
si tu a le temps donne nous un exemple en xlx avec le départ et le résultat
juste quelques lignes

Je t'assure que j'ai fait ça à la va vite. En gros, je me suis imposé d'alimenter 2 listboxs via listbox.list au lieu de listbox.add.

Merci de vouloir m'aider. Toute ma reconnaissance.

Bonne soirée.

XL 2010 Récupérer données d'un Array 2D dans 1D

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cp4

XLDnaute Barbatruc

Discussions similaires