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

cp4

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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:D" & 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 ;)
 
Dernière édition:

cp4

XLDnaute Barbatruc
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:D" & 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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

laurent950

XLDnaute Accro
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
 
Dernière édition:

cp4

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

Discussions similaires

Réponses
3
Affichages
533

Statistiques des forums

Discussions
311 711
Messages
2 081 792
Membres
101 817
dernier inscrit
carvajal