Tableau croisé VBA

Bonjour dans le fichier ci-joint j'aimerais à partir de l'onglet "Clement" faire lasomme des montants négatifs seulement par mois et par rubrique et les reporter dans l'onglet "Resume2011" au bon mois et sous la bonne rubrique. J'ai commencé à écrire le code en VBA mais j'aurais besoin de votre aide pour le continuer. J'ai fait ce tableau avec des "SOMMEPROD" mais ça devient très lent à se comptabiliser. J'y ajouterai évidemment un bouton pour déclencher le code.

Merci à l'avance.

Clément

17budget.xlsm (108.56 Ko)

Salut le forum

Jujube, il est de mise sur un forum de fourni la solution trouvée,

cela pourrait être utile pour quelqu'un d'autre.

Mytå

Bonjour Mytå, je te remercie de ton commentaire il est très juste.

Je mets ici le code que j'ai écris dans le module 1 de mon programme.

Faut faire attention, dans la feuille "Clement" le programme commence à lire à la ligne 12 et non pas à la ligne 4.

Il y a peut-être plus simple à faire, mais je l'ignore.

Merci à toutes et à tous. À lire toutes les réponses proposées à travers le forum je suis arrivé à ce résultat.

Sub Compiler()

Dim DerLigne As Integer

Dim Colonne As Integer ' le nombre de colonnes dans le tableau

Dim R As Integer

Dim C As Integer

Dim taille As Integer

Dim compteur As Integer

Dim Annee As Integer

Dim Mois As Integer

Feuille = "Resume2011"

Annee = 2011

'Dernière ligne de la base de données

DerLigne = Sheets("Clement").Range("A12").End(xlDown).Row

taille = WorksheetFunction.Count(Sheets("Clement").Range("B12:S" & DerLigne))

'Enregistrement de la base de données dans un tableau

Colonne = 19

Dim BD()

ReDim BD(DerLigne, Colonne)

'Enregistrer le tableau

For C = 1 To 19

For R = 12 To DerLigne

BD(R, C) = Sheets("Clement").Cells(R, C)

Next R

Next C

Dim Montant

Dim x As Integer ' pour les rangées

x = 6

For C = 2 To 19

For Mois = 1 To 12

x = x + 1

Montant = 0 ' remettre le montant à zéro

For R = 12 To DerLigne

If Year(BD(R, 1)) = Annee And Month(BD(R, 1)) = Mois Then

If Val(Val(BD(R, C))) < 0 Then

Montant = Montant + Val(BD(R, C))

End If

End If

Next R

Sheets(Feuille).Cells(x, C + 1) = Montant

Next Mois

x = 6 ' remettre le compteur à la ligne 6

Next C

End Sub

Clément

Rechercher des sujets similaires à "tableau croise vba"