VBA tableaux de variable

Version imprimable

Bonjour à toutes et à tous,

Voilà j'ai un onglet ( Feuil1) dans lequel se trouve des données (un tableau ≠ tableau de variable)

Je souhaite intégrer ces données dans un tableau de variable par une boucle.

J'ai donc fait:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub tab_varA() 'Définition du tableau Dim tab_exemple() 'Déclaration Dim dern_ligne As Variant Dim dern_col As Variant Dim i As Variant 'définition des limites du tableau dern_ligne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row dern_col = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column 'Enregistrement des valeurs dans le tableau For i = 0 To dern_ligne For j = 0 To dern_col tab_exemple(i, j) = Feuil1.Cells(i + 1, j + 1) Next Next End Sub
Mais ça ne marche pas, j'ai un message d'erreur "l'indice n'appartient pas à la sélection",

Si quelqu'un a une idée de l'erreur à corriger, je suis preneur.

Merci à tous.

Citation:

Envoyé par manufer

Bonjour,

Si vous voulez utiliser la matrice en dehors de la procédure tab_varA, il faut au moins la déclarer Private (ou Dim) en tête de module, voire Public si utilisée dans un autre module.
Attention, dans l'exemple, les colonnes et lignes sont inversées car j'utilise Preserve dans le redimensionnement de la matrice.

A tester :

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
33
34
35
36
37
38
39
40
41
42
 
Option Explicit
 
Public tab_exemple() As Variant
 
Sub Testtab_varA()
 
Dim I As Long
 
    tab_varA
 
     For I = LBound(tab_exemple, 2) To UBound(tab_exemple, 2)
        Debug.Print tab_exemple(0, I) & ", " & tab_exemple(1, I)
     Next I
 
 
End Sub
 
Sub tab_varA()
 
'Déclaration
Dim Dern_ligne As Long, Dern_col As Long, I As Long, J As Long
 
    Erase tab_exemple
 
    'définition des limites du tableau
    With Feuil1
         Dern_ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Dern_col = .Cells(1, .Columns.Count).End(xlToLeft).Column
 
         'Enregistrement des valeurs dans le tableau
         For I = 0 To Dern_ligne - 1
             ReDim Preserve tab_exemple(Dern_col - 1, I)
             For J = 0 To Dern_col - 1
                 tab_exemple(J, I) = .Cells(I + 1, J + 1)
             Next J
         Next I
 
    End With
 
 
End Sub

Suite

Je crois avoir trouvé une piste:

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
 
Sub tab_varA()
 
'Définition du tableau
Dim tab_exemple()
 
'Déclaration
Dim dern_ligne As Variant
Dim dern_col As Variant
Dim i As Variant
Dim j As Variant
 
 
 
'définition des limites du tableau
dern_ligne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
dern_col = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column
 
ReDim tab_exemple(dern_ligne, dern_col)
 
'Enregistrement des valeurs dans le tableau
For i = 0 To dern_ligne
    For j = 0 To dern_col
        tab_exemple(i, j) = Feuil1.Cells(i + 1, j + 1)
        MsgBox tab_exemple(i, j)
 
    Next
Next
 
End Sub

Mais j'ai encore un petit problème sur la dernière colonne sur laquelle je boucle.

02/06/2020, 11h40
manufer

Merci Eric KERGRESSE,

Je vais essayer.
03/06/2020, 09h28
pijaku
Bonjour,

1- pourquoi une boucle?

2- Remplacer :
Code:

1 2 3 ReDim tab_exemple(dern_ligne, dern_col) For i = 0 To dern_ligne For j = 0 To dern_col
par :
Code:

1 2 3 ReDim tab_exemple(0 To dern_ligne - 1, 0 To dern_col - 1) For i = 0 To dern_ligne - 1 For j = 0 To dern_col - 1
En effet, si, dans l'exemple, dern_ligne = 10, tu va boucler de la ligne 1 à la 10.
Et tu vas donc mettre ces valeurs dans ta variable tableau, aux indices : de 0 à 9...
03/06/2020, 11h18
anasecu

Bonjour,

Pourquoi une boucle quand VBA le fait en une ligne ?

Code:

tab_exemple = Feuil1.Cells(1, 1).Resize(dern_ligne, dern_col).Value
03/06/2020, 14h51
manufer

Ah cool,

Il est vrai que si je peux faire en une ligne de code ce que je faisais avec 4 ou 5 lignes c'est meilleur.

Ce que vous m'avez transmit fonctionne très bien merci.

Bonjour,

Effectivement ça merche presque sauf que lorsque j'établit une égalité entre 2 tableaux de variables,

mon code indique "l'indice n'appartient pas à la sélection":

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
 
Sub tab_varA()
 
 
'Définition des tableaux de variable
Dim tab_varA()
Dim tab_varB()
 
'Déclaration des variables
Dim dern_ligne As Long 'Cette variable représentera la dernière cellule non-vide feuil1
Dim dern_col As Long 'Cette variable représentera la dernière colonne non-vide feuil1
Dim dern_ligne_B As Long 'Cette variable représentera la dernière cellule non-vide feuil2
Dim dern_col_B As Long 'Cette variable représentera la dernière colonne non-vide feuil2
Dim i As Long 'Nous utiliserons cette variable pour les lignes dans les boucles
Dim t As Long
 
 
 
'définition des limites du tableau
dern_ligne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil1
dern_col = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil1
dern_ligne_B = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil2
dern_col_B = Feuil2.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil2
 
 
'Redimensionnement du tableau A
tab_varA = Feuil1.Cells(1, 1).Resize(dern_ligne, dern_col).Value
 
'Redimensionnement du tableau B
tab_varB() = Feuil2.Cells(1, 1).Resize(dern_ligne_B, dern_col_B).Value
 
'Boucle sur le tableau feuil1
For i = LBound(tab_varA, 1) To UBound(tab_varA, 1)
 
''Boucle sur le tableau feuil2
        For t = LBound(tab_varB, 1) To UBound(tab_varB, 1)
 
'Si égalité entre tableau
            If tab_varB(t, 2) = tab_varA(i, 9) Then
 
'Résultat attendu
                tab_varB(t, 6) = tab_varB(t, 6) + tab_varA(i, 16)
            End If
        Next t
Next i
 
end sub

Apparemment, c'est à cette ligne que le code bloque:

Code:

If tab_varB(t, 2) = tab_varA(i, 9)

Est ce que vous sauriez pourquoi svp ?

08/06/2020, 11h55
manufer

Désolé de vous avoir dérangé, j'ai trouvé le problème.

J'ai mal définit cette partie.

Code:

dern_col_B = Feuil2.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil2

Par contre je trouve que mon code met beaucoup de temps à s’exécuter (plusieurs minutes),

Savez vous comment je peux le rendre plus rapide svp ?
08/06/2020, 21h37
anasecu

Bonsoir,

Citation:

Envoyé par manufer

Par contre je trouve que mon code met beaucoup de temps à s’exécuter (plusieurs minutes),

Je ne sais pas la taille des tableaux ni ta configuration mais normalement ce genre de module devrait être pratiquement instantané.

Le code a l'air clair mais sans test l'on ne peut pas être sûr de passer à côté du problème.

Si tu as beaucoup de colonnes, il faudrait peut-être ne mettre en table que les colonnes utiles.

Bonjour,

Je reviens parce que le temps d’exécution du code reste problématique (près de 6 minutes voir plus).

Le premier tableau 'tab_varA' fait 16 colonnes et + de 75 000 lignes

Le second tableau 'tab_varA' fait 10 colonnes et plus de 1 600 lignes

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
 
Sub tab_Realise()
 
'Routine de début
tempcalc = Application.Calculation
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Visible = True
Application.Calculation = xlCalculationManual
 
'Définition du tableau de variable
Dim tab_varA()
Dim tab_varB()
Dim tabdat_crs(1) As Long
Dim tabdat_ant(2) As Long
 
'Déclaration des variables
Dim dern_ligne As Long 'Cette variable représentera la dernière cellule non-vide feuil1
Dim dern_col As Long 'Cette variable représentera la dernière colonne non-vide feuil1
Dim dern_ligne_B As Long 'Cette variable représentera la dernière cellule non-vide feuil2
Dim dern_col_B As Long 'Cette variable représentera la dernière colonne non-vide feuil2
Dim i As Long 'Nous utiliserons cette variable pour les lignes dans les boucles
Dim t As Long
 
 
 
'définition des limites du tableau
dern_ligne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil1
dern_col = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil1
dern_ligne_B = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil2
dern_col_B = Feuil2.Cells(26, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil2
 
tabdat_crs(1) = Feuil2.Range("Ex_crs") 'une donnée date inscrite dans une cellule
tabdat_ant(2) = Feuil2.Range("Ex_ant") 'une donnée date inscrite dans une cellule
 
 
'Redimensionnement du tableau en fonction des variables: dern_ligne et dern_col feuil1
ReDim tab_varA(dern_ligne, dern_col) 'La taille du tableau est maintenant égal à la valeur de ces variables feuil1
'Redimensionnement du tableau en fonction des variables: dern_ligne et dern_col feuil2
ReDim tab_varB(dern_ligne_B, dern_col_B) 'La taille du tableau est maintenant égal à la valeur de ces variables feuil2
 
 
'Redimensionnement du tableau A
tab_varA = Feuil1.Cells(1, 1).Resize(dern_ligne, dern_col).Value
'Redimensionnement du tableau B
tab_varB = Feuil2.Cells(1, 1).Resize(dern_ligne_B, dern_col_B).Value
 
 
For i = LBound(tab_varA, 1) To UBound(tab_varA, 1)
	'Dans cette première boucle, nous allons obtenir le total général de produit
        For t = LBound(tab_varB, 1) To UBound(tab_varB, 1)
    'Si égalité entre tableau
                If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = tabdat_ant(2) Then
    'Résultat attendu
                    Feuil2.Cells(t, 6) = Feuil2.Cells(t, 6) + tab_varA(i, 16)
                End If
 
                If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = tabdat_crs(1) Then
    'Résultat attendu
                    Feuil2.Cells(t, 9) = Feuil2.Cells(t, 9) + tab_varA(i, 16)
                End If
        Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Ici nous allons boucler pour obtenir un quantité de produit plus spécifique 
	If tab_varA(i, 15) = "NON-Admissible" Then
                For t = LBound(tab_varB, 1) To UBound(tab_varB, 1)
                        'Si égalité entre tableau
                        If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = Feuil2.Range("Ex_ant") Then
                        'Résultat attendu
                            Feuil2.Cells(t, 7) = Feuil2.Cells(t, 7) + tab_varA(i, 16)
                        End If
 
                        If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = Feuil2.Range("Ex_crs") Then
                        'Résultat attendu
                            Feuil2.Cells(t, 10) = Feuil2.Cells(t, 10) + tab_varA(i, 16)
                        End If
                Next
        End If
Next i
 
 
'routine de fin
Application.EnableEvents = True 'desactiver les evenements
Application.ScreenUpdating = True 'rafraichissement du tableau
Application.Visible = True
Application.Calculation = tempcalc
 
End Sub

Que puis-je faire pour accélérer l’exécution du code svp ?

01/07/2020, 09h02
anasecu

Bonjour,

Citation:

Envoyé par manufer

Je reviens parce que le temps d’exécution du code reste problématique (près de 6 minutes voir plus).

Il me semble que tu pourrais au moins éviter de faire 2 boucles successives sur tab_varB en faisant ton test sur la première boucle.

D'autre part, je n'ai sans doute pas tout compris, mais au lieu d'utiliser du VBA, ne serait-il pas plus simple d'utiliser des fonctions pour réaliser tes cumuls ?
01/07/2020, 09h35
manufer

Salut,

Je suis passé par du VBA parce qu'avec les fonction excel c'était très très long.

Le problème c'est que maintenant c'est aussi long avec le VBA.

Je vais voir pour faire une seule boucle.
01/07/2020, 10h33
anasecu

re

Pour gagner du temps aussi tu pourrais mettre en table les 4 colonnes que tu cumules
faire tes cumuls sur les tables au lieu de le faire sur la feuille
puis mettre tes tables sur la feuille.

Cela devrait être plus rapide.
01/07/2020, 15h39
manufer

je n'ai pas la possibilité d'installer une base de donnée sur mon poste,

Je ne peux travailler qu'avec des fichiers excel.

Même avec une seule boucle, j'ai 6min d'exécution.

Est-il possible de passer par un autre moyen svp ?

bonsoir,

Suite à ma suggestion, je te propose ceci mais je n'ai pas testé avec 75 000 lignes :

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Sub tab_Realise()
 
'Routine de début
Dim tempcalc As Long
tempcalc = Application.Calculation
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Visible = True
Application.Calculation = xlCalculationManual
 
'Définition du tableau de variable
Dim tab_varA()
Dim tab_varB()
Dim tb_6()
Dim tb_7()
Dim tb_9()
Dim tb_10()
Dim tabdat_crs(1) As Long
Dim tabdat_ant(2) As Long
 
'Déclaration des variables
Dim dern_ligne As Long 'Cette variable représentera la dernière cellule non-vide feuil1
Dim dern_col As Long 'Cette variable représentera la dernière colonne non-vide feuil1
Dim dern_ligne_B As Long 'Cette variable représentera la dernière cellule non-vide feuil2
Dim dern_col_B As Long 'Cette variable représentera la dernière colonne non-vide feuil2
Dim i As Long 'Nous utiliserons cette variable pour les lignes dans les boucles
Dim t As Long
 
 
 
'définition des limites du tableau
dern_ligne = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil1
dern_col = Feuil1.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil1
dern_ligne_B = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row 'Trouve la valeur de la dernière ligne non-vide de l'onglet feuil2
dern_col_B = Feuil2.Cells(1, Columns.Count).End(xlToLeft).Column 'Trouve la valeur de la dernière dernière colonne non-vide de l'onglet feuil2
 
tabdat_crs(1) = Feuil2.Range("Ex_crs") 'une donnée date inscrite dans une cellule
tabdat_ant(2) = Feuil2.Range("Ex_ant") 'une donnée date inscrite dans une cellule
 
'Redimensionnement du tableau A
tab_varA = Feuil1.Cells(1, 1).Resize(dern_ligne, dern_col).Value
'Redimensionnement du tableau B
tab_varB = Feuil2.Cells(1, 1).Resize(dern_ligne_B, dern_col_B).Value
' colonnes à calculer en table
tb_6 = Feuil2.Cells(1, 6).Resize(dern_ligne_B, 1).Value
tb_7 = Feuil2.Cells(1, 7).Resize(dern_ligne_B, 1).Value
tb_9 = Feuil2.Cells(1, 9).Resize(dern_ligne_B, 1).Value
tb_10 = Feuil2.Cells(1, 10).Resize(dern_ligne_B, 1).Value
 
For i = LBound(tab_varA, 1) To UBound(tab_varA, 1)
    'Dans cette première boucle, nous allons obtenir le total général de produit
        For t = LBound(tab_varB, 1) To UBound(tab_varB, 1)
    'Si égalité entre tableau
                If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = tabdat_ant(2) Then
    'Résultat attendu
                    tb_6(t, 1) = tb_6(t, 1) + tab_varA(i, 16)
                End If
 
                If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = tabdat_crs(1) Then
    'Résultat attendu
                    tb_9(t, 1) = tb_9(t, 1) + tab_varA(i, 16)
                End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Ici nous allons boucler pour obtenir un quantité de produit plus spécifique
                If tab_varA(i, 15) = "NON-Admissible" Then
                        'Si égalité entre tableau
                        If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = Feuil2.Range("Ex_ant") Then
                        'Résultat attendu
                            tb_7(t, 1) = tb_7(t, 1) + tab_varA(i, 16)
                        End If
 
                        If tab_varB(t, 1) = tab_varA(i, 13) And tab_varB(t, 2) = tab_varA(i, 9) And tab_varB(t, 3) = tab_varA(i, 10) And tab_varB(t, 4) = tab_varA(i, 11) And tab_varA(i, 1) = Feuil2.Range("Ex_crs") Then
                        'Résultat attendu
                            tb_10(t, 1) = tb_10(t, 1) + tab_varA(i, 16)
                        End If
                End If
        Next t
Next i
Feuil2.Cells(1, 6).Resize(dern_ligne_B, 1) = tb_6
Feuil2.Cells(1, 7).Resize(dern_ligne_B, 1) = tb_7
Feuil2.Cells(1, 9).Resize(dern_ligne_B, 1) = tb_9
Feuil2.Cells(1, 10).Resize(dern_ligne_B, 1) = tb_10
 
'routine de fin
Application.EnableEvents = True 'desactiver les evenements
Application.ScreenUpdating = True 'rafraichissement du tableau
Application.Visible = True
Application.Calculation = tempcalc
 
End Sub