Créer une array et l'utiliser pour faire des calculs

[fb62840]

Bonjour à toutes et tous,

Voici ce que je cherche à faire :

Dans un classeur sur la feuille Base j'ai les données :
J'aimerais placer des données dans une array afin de pouvoir réaliser des calculs

Il s'agirait de créer une array à 4 dimensions, la première serait contenu :
en colonne A sur une feuille "Base"

Les autres serait à "calculer à partir de données présentes sur trois feuilles

L'architecture de ces 3 feuille et identique :
une colonne A contient plusieurs fois tout ou partie des noms de la feuille Base
Une colonne F contient une note

Il s'agirait donc de placer en seconde dimension de l'array, la somme des notes (en colonne F de la feuille Notes1) pour le premier nom trouvé sur la feuille Base en colonne A, puis la somme des notes pour chacun des noms trouvés dans la même colonne.

même chose pour la somme des notes en colonne F de la feuille Notes2

et pour la la feuille Notes3.

Le fichier joint devrait être (plus) clair (?)

L'objectif de la création de cette array est ensuite de pouvoir réaliser 2 calculs :
- un premier calcul la somme de toutes les notes pour un nom sur toutes les feuilles
- un second calcul le rang de chaque nom (Le premier est celui qui obtient le total général le plus élevé, le dernier celui qui obtient le total le plus faible).

Le total général et le rang j'aimerais si possible qu'ils apparaissent sur la feuille Base

Merci beaucoup pour votre aide.

 

[Modeste geedee]

Re : Créer une array et l'utiliser pour faire des calculs

Bonsour®
ce que tu décris est un cube OLAP...
pour cela il faut utiliser SQL Server,
ensuite Excel et VBA permettent l'utilisation de commandes adéquates

Ce lien n'existe plus

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Merci pour cette précision.
Ce sera sans doute un peu trop complexe pour moi mais je vais tout de même essayer de savoir de quoi il retourne.

Bonne soirée.

 

[ROGER2327]

Re : Créer une array et l'utiliser pour faire des calculs

Bonsoir à tous.

Un essai (vite fait) à partir de ce que j'ai compris.​

ROGER2327
#6891

Samedi 7 Haha 141 (Saint Prout, abbé - fête Suprême Quarte)
21 Vendémiaire An CCXXII, 8,7417h - chanvre
2013-W41-6T20:58:48Z

 

[Paf]

Re : Créer une array et l'utiliser pour faire des calculs

bonjour à tous
si j'ai bien compris, bien que le tableau désiré comporte 4 informations, ce sera un tableau à 2 dimensions. Il serait comme un tableau excel comportant 4 colonnes.colonne 1= nom, col 2 somme des notes1 col 3 somme des Notes2 et col 4 somme des Notes3

Dim Montableau

DerlBase = Worksheets("Base").Range("A" & Rows.Count).End(xlUp).Row
    Montableau = Worksheets("Base").Range("A2:A" & DerlBase)

For NoFeuille = 2 To 4
    With Worksheets(NoFeuille)
    Derl = .Range("A" & Rows.Count).End(xlUp).Row

    For i = LBound(Montableau) To UBound(Montableau)
        ReDim Preserve Montableau(1 To UBound(Montableau), 1 To NoFeuille)
        For j = 2 To Derl
            If .Cells(j, 1) = Montableau(i, 1) Then
                Montableau(i, NoFeuille) = Montableau(i, NoFeuille) + .Cells(j, 6)
            End If
        Next
    
    Next
End With
Next

A+

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Bonjour,

Un grand merci pour cette proposition qui effectivement semble être très prometteuse.

Toutefois j'ignore par principe le nombre de noms contenus sur la feuille Base.

J'ai donc modifié le code ainsi mais il me reste un souci car il est possible que le nombre de fois où est cité le nom sur les pages Notes1, Notes2 et Notes3. Il se pourrait parfaitement que pour l'un des noms on ait 10 notes sur la feuille Notes1, 8 notes sur la feuilles Notes 2 et aucune note sur la feuille Notes3.

voici le code modifié qui fonctionne si j'ajoute des noms mais il est imparfait car pour identifier le nombre de lignes à balayer je me suis basé sur le nombre de lignes contenues sur la feuille Notes1. Il est fonctionnel tant que l'on considère le nombre de lignes à balayer qui se trouve sur Notes1, par contre si le nombre de lignes à balayer sur Notes2 ou Notes3 n'est pas le même ça ne marche pas car il ne les prends alors pas en compte.

Dim i, j, k, l, m, d(), x
Dim nom, donnée
Dim nbnoms As Integer
Dim nbnotes As Integer
nbnoms = Sheets("Base").Range("a2").End(xlDown).Row
    ReDim d(1 To nbnoms, 1 To nbnoms, 1 To 3)
    For i = 1 To nbnoms
        nom = Feuil1.[A1].Offset(i).Value
    For j = 1 To nbnoms
        donnée = Feuil1.[A1].Offset(, j).Value
    For k = 1 To 3
        With Array(, Feuil2, Feuil3, Feuil4)(k).[A1]
nbnotes = Sheets("Notes1").Range("F2").End(xlDown).Row 'C'est là que ça pose problème
            For l = 1 To nbnotes
                If .Offset(l).Value = nom Then
                    For m = 1 To nbnoms
                        If .Offset(, m).Value = donnée Then
                            With .Offset(l, m)
                                If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
                            End With
                        End If
                    Next
                End If
            Next
        End With
    Next k, j, i

Rem * À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
Rem * On en fait alors le traitement qu'on veut. Par exemple :

    With Feuil1.[A1]
        For i = 1 To nbnoms: For j = 1 To nbnoms
            x = Empty
            For k = 1 To 3
                If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
            Next
            .Offset(i, j).Value = x
        Next j, i
    End With

    With Range("G2:G" & nbnoms)
        .FormulaArray = "=IF(ISERROR(RANK(RC[-1]:R[" & nbnoms - 1 & "]C[-1],RC[-1]:R[" & nbnoms - 1 & "]C[-1],0)),"""",RANK(RC[-1]:R[" & nbnoms - 1 & "]C[-1],RC[-1]:R[" & nbnoms - 1 & "]C[-1],0))"
        .Value = .Value
    End With

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Bonjour,

Merci pour cette proposition.

J'ai une erreur à l'exécution sur la ligne :

DerlBase = Worksheets("Base").Range("A" & Rows.Count).End(xlUp).Row

L'exécution bloc sur xlUp

Il s'agit de cette erreur : Erreur de compilation : Instruction incorrecte à l'intérieur d'une procédure

 

[Paf]

Re : Créer une array et l'utiliser pour faire des calculs

re,

avez vous mis le code dans une macro, avez vous rajouté quelques lignes de code ?

ce qui pourrait géner, c'est le défaut de déclaration des variables utilisées (DerlBase, Derl, NoFeuille .....)

Pas pu tester sur excel97.

A+

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Bonjour,

J'ai déclaré les variables mais l'erreur reste la même.
Le code est mis dans une macro associée à un bouton sur la feuille Base

Dim Montableau
Dim DerlBase As Integer
Dim Derl As Integer
Dim NoFeuille As Integer
DerlBase = Worksheets("Base").Range("A" & Rows.Count).End(xlUp).Row
    Montableau = Worksheets("Base").Range("A2:A" & DerlBase)

For NoFeuille = 2 To 4
    With Worksheets(NoFeuille)
    Derl = .Range("A" & Rows.Count).End(xlUp).Row

    For i = LBound(Montableau) To UBound(Montableau)
        ReDim Preserve Montableau(1 To UBound(Montableau), 1 To NoFeuille)
        For j = 2 To Derl
            If .Cells(j, 1) = Montableau(i, 1) Then
                Montableau(i, NoFeuille) = Montableau(i, NoFeuille) + .Cells(j, 6)
            End If
        Next
   
    Next
End With
Next

 

[ROGER2327]

Re : Créer une array et l'utiliser pour faire des calculs

Re...

(...)

Toutefois j'ignore par principe le nombre de noms contenus sur la feuille Base.

Comment en conséquence pourrais-je modifier le code afin qu'au lieu de se concentrer sur 5 valeurs se concentre sur toutes les valeurs contenus dans la colonne A sur la feuille Base (à l'exception de la première) ?

(...)

À essayer :

Sub toto()
Dim i, im, j, k, l, m, d(), x
Dim nom, donnée
    With Feuil1
        im = .Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1
        ReDim d(1 To im, 1 To 5, 1 To 3)
        For i = 1 To im
            nom = .[A1].Offset(i).Value
        For j = 1 To 5
            donnée = .[A1].Offset(, j).Value
        For k = 1 To 3
            With Array(, Feuil2, Feuil3, Feuil4)(k).[A1]
                For l = 1 To 15
                    If .Offset(l).Value = nom Then
                        For m = 1 To 5
                            If .Offset(, m).Value = donnée Then
                                With .Offset(l, m)
                                    If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
                                End With
                            End If
                        Next
                    End If
                Next
            End With
        Next k, j, i

Rem * À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
Rem * On en fait alors le traitement qu'on veut. Par exemple :

        For i = 1 To im: For j = 1 To 5
            x = Empty
            For k = 1 To 3
                If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
            Next
            .[A1].Offset(i, j).Value = x
        Next j, i

        With .Range("G2").Resize(im, 1)
            .FormulaArray = "=IF(ISERROR(RANK(RC[-1]:R[4]C[-1],RC[-1]:R[4]C[-1],0)),"""",RANK(RC[-1]:R[4]C[-1],RC[-1]:R[4]C[-1],0))"
            .Value = .Value
        End With

    End With

End Sub

ROGER2327
#6896

Dimanche 8 Haha 141 (Fête du Haha - fête Suprême Seconde)
22 Vendémiaire An CCXXII, 4,6468h - pêche
2013-W41-7T11:09:09Z

 

[Paf]

Re : Créer une array et l'utiliser pour faire des calculs

pouvez vous mettre le code complet de la macro?

à tout hasard remplacer DerlBase=.... , par DerlBase = Range("A65536").End(xlUp).Row (idem pour Derl si cette étape est passée)

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Merci Roger,

Je viens de tester,

Le report du total général ne se fait pas pour les 2 noms que j'ai ajouté
La colonne Rang affiche par contre 2 lignes supplémentaires (celles pour nom6 et nom7 que j'ai ajouté) et font apparaître #NA

Cela vient peut être du fait que sur le code il me semble que ça ne balaye que les 15 premières lignes qui contiennent des notes alors qu'il faudrait toutes les balayer :

With Array(, Feuil2, Feuil3, Feuil4)(k).[A1]
                For l = 1 To 15

 

[ROGER2327]

Re : Créer une array et l'utiliser pour faire des calculs

Re...

Merci Roger,

Je viens de tester,

Le report du total général ne se fait pas pour les 2 noms que j'ai ajouté
La colonne Rang affiche par contre 2 lignes supplémentaires (celles pour nom6 et nom7 que j'ai ajouté) et font apparaître #NA

Cela vient peut être du fait que sur le code il me semble que ça ne balaye que les 15 premières lignes qui contiennent des notes alors qu'il faudrait toutes les balayer :

With Array(, Feuil2, Feuil3, Feuil4)(k).[A1]
                For l = 1 To 15

Lorsque je lis une demande et que je décide d'y répondre, je réponds (ou, plus précisément, j'essaie de répondre) à la demande.
Relisez vous et vous verrez qu'il n'a jamais été question jusqu'ici de plus de quinze lignes par onglet Notes..., lignes qui sont toutes "balayées". D'autant que, dans votre classeur de démonstration, la structure de ces onglets est rigoureusement identique, ce qui n'incite pas à envisager des complications.

On peut parfaitement envisager qu'il y en ait plus, moins, ou même, pas le même nombre dans chaque onglet :​

Sub toto()
Dim i, im, j, k, l, lm, m, d(), x
Dim nom, donnée
    With Feuil1
        im = .Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1
        ReDim d(1 To im, 1 To 5, 1 To 3)
        For i = 1 To im
            nom = .[A1].Offset(i).Value
        For j = 1 To 5
            donnée = .[A1].Offset(, j).Value
        For k = 1 To 3
            With Array(, Feuil2, Feuil3, Feuil4)(k)
                lm = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                With .[A1]
                    For l = 1 To lm
                        If .Offset(l).Value = nom Then
                            For m = 1 To 5
                                If .Offset(, m).Value = donnée Then
                                    With .Offset(l, m)
                                        If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
                                    End With
                                End If
                            Next
                        End If
                    Next
                End With
            End With
        Next k, j, i

' À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
' On en fait alors le traitement qu'on veut. Par exemple :

        For i = 1 To im: For j = 1 To 5
            x = Empty
            For k = 1 To 3
                If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
            Next
            .[A1].Offset(i, j).Value = x
        Next j, i

        With .Range("G2").Resize(im, 1)
            .FormulaArray = "=IF(ISERROR(RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)),"""",RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0))"
            .Value = .Value
        End With

    End With

End Sub

J'en ai profité pour corriger la formule de calcul du rang pour qu'elle s'adapte au nombre de lignes.​

Ce qui serait commode, c'est d'avoir un classeur de travail conforme à votre problème réel, c'est-à-dire montrant précisément la structure réelle de vos données. Avec quelques indications sur les paramètres qui sont variables et ceux qui sont fixes, on pourrait envisager une réponse précise sans perdre de temps à résoudre des faux problèmes...​

Bon dimanche.


ROGER2327
#6897

Dimanche 8 Haha 141 (Fête du Haha - fête Suprême Seconde)
22 Vendémiaire An CCXXII, 5,7160h - pêche
2013-W41-7T13:43:06Z

 

[fb62840]

Re : Créer une array et l'utiliser pour faire des calculs

Bonjour,

Je vous prie d'accepter mes excuses pour la confusion.
Je tiendrais compte à l'avenir de vos remarques.

Bonne fin d'après-midi.

 

[ROGER2327]

Re : Créer une array et l'utiliser pour faire des calculs

Re...

Bonjour,

Je vous prie d'accepter mes excuses pour la confusion.
Je tiendrais compte à l'avenir de vos remarques.

Bonne fin d'après-midi.

Point besoin d'excuses, chacun fait comme il l'entend !
Mes remarques visaient simplement à expliquer le pourquoi du comment de ma proposition et à répéter qu'il est presque toujours plus rapide d'obtenir une réponse pertinente lorsqu'on propose un support vraiment représentatif de la situation réelle.

Ceci dit, votre problème est intéressant et peut être encore développé. Par exemple en traitant le cas où le nombres de feuilles à traiter est variable.

Supposons qu'on veuille traiter tous les onglets dont le nom commence par Notes. On pourrait utiliser ce code :​

Sub toto()
Dim i, im, j, km, k, l, lm, m, d(), x
Dim nom, donnée, feuille, f As Worksheet

' Relevé des feuilles à traiter : Cette feuille, et toutes les feuilles
' dont le nom d'onglet dont le nom commence par "Notes".
' À adapter selon les besoins.

    feuille = Array(Me.Name)
    For Each f In ThisWorkbook.Worksheets
        If f.Name Like "Notes*" Then
            ReDim Preserve feuille(1 + UBound(feuille))
            feuille(UBound(feuille)) = f.Name
        End If
    Next

' On aurait pu aussi écrire :
'   feuille = Array("Base", "Notes Spéciales", "Notes1", "Notes2", "Notes3")

    km = UBound(feuille)

    With ThisWorkbook.Worksheets(feuille(0))
        im = .Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1
        ReDim d(1 To im, 1 To 5, 1 To km)
        For i = 1 To im
            nom = .[A1].Offset(i).Value
        For j = 1 To 5
            donnée = .[A1].Offset(, j).Value
        For k = 1 To km
            With ThisWorkbook.Worksheets(feuille(k))
                lm = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                With .[A1]
                    For l = 1 To lm
                        If .Offset(l).Value = nom Then
                            For m = 1 To 5
                                If .Offset(, m).Value = donnée Then
                                    With .Offset(l, m)
                                        If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
                                    End With
                                End If
                            Next
                        End If
                    Next
                End With
            End With
        Next k, j, i

' À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
' On en fait alors le traitement qu'on veut. Par exemple :

        For i = 1 To im: For j = 1 To 5
            x = Empty
            For k = 1 To km
                If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
            Next
            .[A1].Offset(i, j).Value = x
        Next j, i

        With .Range("G2").Resize(im, 1)
            .FormulaArray = "=IF(RC[-1]:R[" & im - 1 & "]C[-1]="""","""",IF(ISERROR(RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)),"""",RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)))"
            .Value = .Value
        End With

    End With

End Sub

ou cette variante (un peu plus compliquée) :​

Sub toto1() 'Variante acceptant indifféremment l'indexation des feuilles par
'le nom de feuille ou le nom d'onglet.
Dim i, im, j, km, k, l, lm, m, d(), x
Dim nom, donnée, feuille, f As Object

' Relevé des feuilles à traiter : Cette feuille, et toutes les feuilles
' dont le nom d'onglet dont le nom commence par "Notes".
' À adapter selon les besoins.

    feuille = Array(Me.Name)
    For Each f In ThisWorkbook.Worksheets
        If f.Name Like "Notes*" Then
            ReDim Preserve feuille(1 + UBound(feuille))
            Set feuille(UBound(feuille)) = f
        End If
    Next

' On aurait pu aussi écrire :
'   feuille = Array("Base", "Notes Spéciales", Feuil2, "Notes2", Feuil4)

    km = UBound(feuille)
    For i = 0 To km
        If VarType(feuille(i)) = 8 Then Set feuille(i) = Sheets(feuille(i))
    Next

    With feuille(0)
        im = .Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1
        ReDim d(1 To im, 1 To 5, 1 To km)
        For i = 1 To im
            nom = .[A1].Offset(i).Value
        For j = 1 To 5
            donnée = .[A1].Offset(, j).Value
        For k = 1 To km
            Set f = feuille(k)
            With f
                lm = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
                With .[A1]
                    For l = 1 To lm
                        If .Offset(l).Value = nom Then
                            For m = 1 To 5
                                If .Offset(, m).Value = donnée Then
                                    With .Offset(l, m)
                                        If Not IsEmpty(.Value) Then d(i, j, k) = d(i, j, k) + .Value
                                    End With
                                End If
                            Next
                        End If
                    Next
                End With
            End With
        Next k, j, i

' À ce stade, d(i,j,k) contient le cumul des valeurs associés au nom i et à la donnée j dans la feuil notes k.
' On en fait alors le traitement qu'on veut. Par exemple :

        For i = 1 To im: For j = 1 To 5
            x = Empty
            For k = 1 To km
                If Not IsEmpty(d(i, j, k)) Then x = x + d(i, j, k)
            Next
            .[A1].Offset(i, j).Value = x
        Next j, i

        With .Range("G2").Resize(im, 1)
            .FormulaArray = "=IF(RC[-1]:R[" & im - 1 & "]C[-1]="""","""",IF(ISERROR(RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)),"""",RANK(RC[-1]:R[" & im - 1 & "]C[-1],RC[-1]:R[" & im - 1 & "]C[-1],0)))"
            .Value = .Value
        End With

    End With

End Sub

Exemple de mise en œuvre dans le classeur joint.​

Bonne nuit !


ROGER2327
#6901

Lundi 9 Haha 141 (Tautologie - Vacuation)
23 Vendémiaire An CCXXII, 0,6074h - navet
2013-W42-1T01:27:28Z