Discussion :

[crissud]

Bonjour

Je souhaite établir un tableau à partir d'une liste, sans avoir recours à un TCD, car j'ai l'intention de manipuler les données ou tout simplement à y mettre un filtre.

J'ai construis une formule excel qui va bien

Code :

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

=SOMMEPROD((NB.SI($A2;Data!$B$3:$B$65500)=1)*(NB.SI(B$1;Data!$A$3:$A$65500)=1)*Data!$C$3:$C$65500)

Je voudrais par une macro envoyer les données dans le tableau.

Je cherche donc à mettre au point cette macro, j'ai repris une macro que j'essaye d'adapter et là je bloque j'ai besoin de vous à ce stade.

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
Sub Fill()
Dim r As Range
Dim NbLigne As Long
Dim NbColonne As Long
Dim value As Double
Dim SommeProd As Variant
 
Dim PlageCompte As objPlageDeComptes
Dim ListePlageComptes As New objListePlageDeComptes
 
 
 NbLigne = Sheets("Data").[A1].CurrentRegion.Rows.Count '
 NbColonne = Sheets("Résultat").Range("A1").End(xlToRight).Column
 
 
    For Each r In Sheets("Résultat").Range("A2:A" & NbLigne)
        ListePlageComptes.Clear
        ListePlageComptes.Init (r.Offset(0, 2).value)
        value = 0
            For Each PlageCompte In Sheets("Résultat").Range("A:NbColonne" & 1)
 
                SommeProd = Evaluate("sumproduct((COUNTIFI($A2;Data!$B$3:$B$65500)=1)*(NB.SI(B$1;Data!$A$3:$A$65500)=1)*Data!$C$3:$C$65500)")
 
                If IsNumeric(SommeProd) Then value = value + SommeProd
 
            Next PlageCompte
 
 
        ThisWorkbook.Worksheets(r.value).Range(r.Offset(0, 1).value) = value
 
    Next r

Je joins un fichier, pour test

Merci de votre aide

Christian

Edit modifié dans la formule SOMMEPROD en sumproduct & NB.SI en COUNTIFI

[mercatog]

Bonjour
Evaluate permet d'évaluer une formule en anglais

Code :

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

SommeProd = Evaluate("SUMPRODUCT((COUNTIF($A2, Data!$B$3:....

[crissud]

Bonjour,

Merci, mercatog
J'ai modifié avec sumproduct

mais j'ai un problème dans la définition des plages

@+
Christian

[mercatog]

Essaies ceci (en étudiant chaque ligne)

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
Sub Fill()
Dim NbLig As Long, LastLig As Long
Dim LastCol As Integer
Dim Frml As String
 
With Sheets("Data")                                                  'NbLig: Dernière ligne remplie de la colonne A de la feuille Data
    NbLig = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
 
With Sheets("Résultat")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row                 'LastLig: Dernière ligne remplie de la colonne A de la feuille Résultat
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column         'LastCol: Dernière colonne remplie de la ligne 1 de la feuille Résultat
    Frml = "=SUMPRODUCT((Data!$B$3:$B$" & NbLig & "=$A2)*(Data!$A$3:$A$" & NbLig & "=B$1)*(Data!$C$3:$C$" & NbLig & "))"    'la formule
    With .Range(.Cells(2, 2), .Cells(LastLig, LastCol))
        .Formula = Frml
        .value = .value
    End With
End With
End Sub

[crissud]

j'ai trouvé un autre code, qui pratiquement abouti
J'ai un résultat en tableau, mais encore 2 problèmes à résoudre

-> J'ai des 0 à la place des du résultat du croisement (ils sont bien placés au croisement des coordonnées, c'est déjà bien)
-> Le résultat que je souhaite est l'inverse de ce qui est affiché, abscisse &r ordonnée dans l'autre sens

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
35
36
37
38
39
40
41
42
43
44
45
46
 
 
Sub Macro()
Dim TheCell As Range, TheCellFindX As Range, TheCellFindY As Range, TheResultat As Range
Dim NLigne As Integer, NCol As Integer
Dim value As Double
 
'On boucle sur le contenu de la colonne A
For Each TheCell In Sheets("Data").Range("A2", Sheets("Data").Cells(Rows.Count, "A").End(xlUp))
    'On recherche la veleur dans la colonne A de la feuille 2
    Set TheCellFindY = Sheets("Resultat").Columns("A").Find(TheCell, , , xlWhole, xlByColumns, , True, True)
    'On regarde si une valeur a ete trouvée
    If TheCellFindY Is Nothing Then 'Pas trouvé
        'On selectionne une cellule vide a la suite et On ajoute la valeur dans le tableau Feuille2
        Set TheCellFindY = Sheets("Resultat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
        TheCellFindY = TheCell
    End If
 
    'On cherche la valeur colonne B
    Set TheCellFindX = Sheets("Resultat").Rows(1).Find(TheCell.Offset(0, 1), , , xlWhole, xlByColumns, , True, True)
    'On regarde si valeur trouvée
    If TheCellFindX Is Nothing Then 'Pas trouvé
        'On pointe sur une nouvelle cellule et on ajoute la nouvelle valeur dans le tableau Feuille2
        Set TheCellFindX = Sheets("Resultat").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        TheCellFindX = TheCell.Offset(0, 1)
    End If
    'Arrivé ici, TheCellFindx pointe dans tous les cas la bonne cellule de la ligne 1 du tableau FEuille2
    'et TheCellFindY pointe la bonne cellule de la colonne A
    'Il ne reste plus qu'a cocher l'intersection des 2
 
     SommeProd = Evaluate("sumproduct((COUNTIF($A2;Data!$B$3:$B$65500)=1)*(COUNTIF(B$2;Data!$A$3:$A$65500)=1)*Data!$C$2:$C$65500)")
 
                If IsNumeric(SommeProd) Then value = value + SommeProd
 
 
 
    Sheets("Resultat").Cells(TheCellFindY.Row, TheCellFindX.Column) = value
 
Next
 
'On vide les variables objet
Set TheCellFindY = Nothing
Set TheCellFindX = Nothing
Set TheCell = Nothing
 
End Sub

En fait la variable SommeProd me retourne erreur 2015


Je joins ce nouveau fichier avec ce nouveau code

merci d'avance

[mercatog]

Désolé de te faire la remarque.
A quoi sert de te fournir un code que tu n'essaies pas. Au lieu de ça tu ramasse des bouts de codes à droite et à gauche pour en fin de compte utiliser un marteau pour tuer une mouche.