Discussion :

[jbonneval]

BONJOUR

Je suis entrain d'apprendre à gérer les tableaux sous VBA car je manipule des tableaux sous Excel (Tri, filtre, formule etc...). Ces tableaux rendent mon fichier très lourd et l'exécution des macros est lente.

Du coup j'essaye de créer des tableaux et d'en faire des manipulations standards (tri filtre calcul...).

A ce jour j'ai réussi à créer le tableau dans VBA depuis un tableau dans Excel et de trouver les 3 valeurs les plus grandes de la 2eme colonne.
Le tableau est le suivant dans Excel:
- 1er ligne= Titre (Type, Valeur,Qté,Row)
- 2er ligne= Valeur (LF7 ,89 ,5 ,20)
- 3er ligne= Valeur (LF14, 5 ,2 ,35)
- 4er ligne= Valeur (LF7 , 3 ,4 ,7)
- 5er ligne= Valeur (LF7 ,14 ,8 ,65)
- 6er ligne= Valeur (LF14,25 ,7 ,45)

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
 
Sub Tableau()
 
Der = Worksheets("Sheet1").Range("A1048455").End(xlUp).Row
 
Dim tab_prob(5, 3)
 
For i = 0 To Der - 1
    For c = 0 To 3
        tab_prob(i, c) = Cells(i + 1, c + 1)
    Next
Next
SMax1 = Application.Large(Application.Index(tab_prob, , 2), 1)
SMax2 = Application.Large(Application.Index(tab_prob, , 2), 2)
SMax3 = Application.Large(Application.Index(tab_prob, , 2), 3)
 
 End Sub

Désormais je cherche les fonctions de filtre, tri pour récupérer la valeur de la colonne "Row" correspondant a SMax1 (si plusieurs SMax1 de meme valeur, je tri par la quantité pour prendre la première par défaut) seulement pour les Type LF7.
L'enchainement des fonctions/Applications se fait comme ci dessous
1- Filtre colonne Type LF7
PUIS
2- Tri colonne Qte par ordre croissant
PUIS
3- trouver la ligne du tableau ayant le chiffre le plus grand dans la colonne Valeur
PUIS
4- Renvoyer la valeur de la colonne "Row" de la ligne ayant le chiffre le plus grand dans la colonne Valeur

Merci d'avance poru votre aide
Jerome

[boisgontierjacques]

Bonsoir,

Pour filtrer les LF7

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub FiltreLF7()
  Tbl = Range("A2:D" & Sheets("Sheet1").Range("A65000").End(xlUp).Row).Value
  Dim tmp(): ReDim tmp(1 To UBound(Tbl))
  For i = LBound(Tbl) To UBound(Tbl)
    If Tbl(i, 1) = "LF7" Then n = n + 1: tmp(n) = i
  Next
  ReDim Preserve tmp(1 To n)
  TblLF7 = Application.Index(Tbl, Application.Transpose(tmp), Application.Transpose(Evaluate("Row(1:" & UBound(Tbl, 2) & ")")))
  [g2].Resize(UBound(TblLF7), UBound(TblLF7, 2)) = TblLF7
End Sub

ou

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
 
Sub LF7()
  Tbl = Range("A2:D" & Sheets("Sheet1").Range("A65000").End(xlUp).Row).Value
  TblLF7 = FiltreClé(Tbl, "LF7")
  [g2].Resize(UBound(TblLF7), UBound(TblLF7, 2)) = TblLF7
End Sub
 
Function FiltreClé(Tbl, clé)
  Dim tmp(): ReDim tmp(1 To UBound(Tbl))
  For i = LBound(Tbl) To UBound(Tbl)
    If Tbl(i, 1) = clé Then n = n + 1: tmp(n) = i
  Next
  ReDim Preserve tmp(1 To n)
  FiltreClé = Application.Index(Tbl, Application.Transpose(tmp), Application.Transpose(Evaluate("Row(1:" & UBound(Tbl, 2) & ")")))
End Function

Boisgontier

[jbonneval]

BONJOUR boisgontierjacques

Un GRAND merci pour ton aide, ca marche très bien .
En plus j'arrive à lire/comprendre le code

Quelqu'un aurait il une idée pour le point 2 et 4?

Reminder:
2- Tri colonne Qte par ordre croissant
PUIS
3- trouver la ligne du tableau ayant le chiffre le plus grand dans la colonne Valeur
PUIS
4- Renvoyer la valeur de la colonne "Row" de la ligne ayant le chiffre le plus grand dans la colonne Valeur

Encore Merci
Jerome

[boisgontierjacques]

Bonjour,

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
 
Sub TriTableau2D()
  Dim Tbl()
  Tbl = Range("A2:D" & Sheets("Sheet1").Range("A65000").End(xlUp).Row).Value                                             
  Call Tri(Tbl(), 3, LBound(Tbl, 1), UBound(Tbl, 1))
  [G2].Resize(UBound(Tbl, 1), UBound(Tbl, 2)).Value2 = Tbl
End Sub
 
Sub Tri(a(), ColTri, gauc, droi) ' Quick sort
  ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < ref: g = g + 1: Loop
    Do While ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
       For k = LBound(a, 2) To UBound(a, 2)
         temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
       Next k
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, ColTri, g, droi)
  If gauc < d Then Call Tri(a, ColTri, gauc, d)
End Sub

Boisgontier

[jbonneval]

Hi boisgontierjacques,

You are the best!!

Juste pour mon info,
=> comment on fait pour inverser le tri de décroissant à croissant par exemple?

Encore MERCI t'es un champion, ton classeur m'a appris l'utilisation des fonctions en plus .

Thanks a lot

Jerome

[boisgontierjacques]

Voir PJ

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
33
34
 
Option Compare Text
Sub Tri()
   Dim a()
   a = [A2:B6].Value
   '-- tri nom croissant
   Call Quick(a(), LBound(a), UBound(a), 1, True)
   [D2:E6].Value2 = a
   '-- tri salaire décroissant
   Call Quick(a(), LBound(a), UBound(a), 2, False)
   [g2:h6].Value2 = a
End Sub
 
Sub Quick(a(), gauc, droi, col, ordre) ' Quick sort
 ref = a((gauc + droi) \ 2, col)
 g = gauc: d = droi
 Do
  If ordre Then
    Do While a(g, col) < ref: g = g + 1: Loop
    Do While ref < a(d, col): d = d - 1: Loop
  Else
    Do While a(g, col) > ref: g = g + 1: Loop
    Do While ref > a(d, col): d = d - 1: Loop
  End If
   If g <= d Then
     For i = LBound(a, 2) To UBound(a, 2)
       temp = a(g, i): a(g, i) = a(d, i): a(d, i) = temp
     Next i
     g = g + 1: d = d - 1
   End If
  Loop While g <= d
  If g < droi Then Call Quick(a, g, droi, col, ordre)
  If gauc < d Then Call Quick(a, gauc, d, col, ordre)
End Sub

Boisgontier

[jbonneval]

Milles Merci t'es un Boss!