Equivalent Sommeprod en VBA

Version imprimable

Bonjour le forum

me revoilà avec un autre problème que je sollicite votre aide pour le solutionner.
je voudrais obtenir l'équivalent de sommprod mais en vba dans ma feuil2

Feuil5
A D
263/01/2012/0001 322 505,23
263/01/2012/0001 746 100,87
263/01/2012/0001 10 305,35
263/01/2012/0002 1 506,22
263/01/2012/0002 4 509,22

Résultat souhaité en Feuil2
A D
263/01/2012/0001 1 078 911,45
263/01/2012/0002 6 015,44

j'ai adapter un code que j'ai trouver en cherchant sur le net il régénère beaucoup d'erreurs.
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 Sub sommprod() Dim fin_Feuil_Données As Integer Dim fin_Feuil_Result As Integer Dim i As Integer Dim x As Integer Feuil_Données = "Feuil5" Feuil_Result = "Feuil2" With Feuil5 fin_Feuil_Données = .Range("A65000").End(xlUp).Row If fin_Feuil_Données = 1 Then MsgBox "Votre colonne A est vide": Exit Sub 'Suprimme les doubles items For i = fin_Feuil_Données To 2 Step -1 For x = i - 1 To 2 Step -1 If (Cells(i, 1) = Cells(x, 1) Or Cells(x, 1) = "") Then Cells(i, 1).EntireRow.Delete End If Next x Next i 'Va chercher les montant fin_Feuil_Result = Feuil2.Range("A65000").End(xlUp).Row Feuil2.Columns("D:D").Clear For i = 2 To fin_Feuil_Result For x = 2 To fin_Feuil_Données If Feuil2.Cells(i, 1) = Feuil5.Cells(x, 1) Then Feuil2.Cells(i, 4).Value = Feuil2.Cells(i, 4).Value + Feuil5.Cells(x, 4).Value 'If Sheets(Feuil_Result).Cells(i, 1) = Sheets(Feuil_Données).Cells(x, 1) Then 'Sheets(Feuil_Result).Cells(i, 4).Value = Sheets(Feuil_Result).Cells(i, 4).Value + Sheets(Feuil_Données).Cells(x, 4).Value End If Next Next End With End Sub
une erreur incompatible de type sur la ligne coloré

Merci d'avance et bonne journée

29/05/2013, 15h22
Fvandermeulen

Salut,

Si j'ai bien vu ta ligne en erreur est dans une zone With feuil5
Donc en écrivant sur cette ligne +feuil5 tu utilise deux fois feuil5

Essaie avec

Code:

Feuil2.Cells(i, 4).Value = Feuil2.Cells(i, 4).Value + .Cells(x, 4).Value

Perso j'évite les With mais j'utilise des variables de type worksheet pour gérer mes feuilles, mais je crois que ce n'est qu'une question d'habitude/préférence

A+
29/05/2013, 15h57
BERRACHED SAID

merci Fvandermeulen

c'est bon pour l'erreur mais le problème c'est qu'il fait pas les additions il transfère les montant telle qu'ils sont il les met dans la colonne "D" alors vous voyez un peu le désordre que ça fait.

Merci encore
29/05/2013, 16h32
Ashireon

Je ne comprends pourquoi tu supprimes des lignes entières de ta source de données tu perds forcement les valeurs associés ??? Tu supprimes tous les blancs ?
29/05/2013, 16h42
BERRACHED SAID

merci Ashireon

c'est un code que j'ai trouvé sur le net et je l'ai adapter a mon cas de figure
mais simplement il fonctionne mal il ne fait les additions pour moi la source des données est la feuil5 la feuil de destination la feuil2.

j'aimerai avoir un coup de main

Merci encore
29/05/2013, 16h51
Ashireon

Peux tu envoyer le fichier voir la structure des tables
Dans la feuille de destination as tu bien les criteres suivant renseigné

"263/01/2012/0001" mais une seule fois au lieu de plusieurs dans celle de données ?
29/05/2013, 17h14
BERRACHED SAID

salut

j'aimerai bien t'envoyer le fichier mais il est volumineux mais quant je vais t'expliquer la demarche.

c'est un fichier qui traite les créances par secteur.

dans la feuil2 c'est celle destiné a recevoir les données pour être imprimés
la feuil5 c'est celle des recouvrement opérés, dans la feuil2 il y a qu'une seul écriture celle relative a la créance mais dans la feuil5 il se pourrait que pour un seul numero il y a plusieurs recouvrements. comme ceci

Feuil2 de destination

Colonne "A" Colonne "C" Colonne "D"
263/01/2012/0001 11*093*841,85 Sommeprod de la Creance

Feuil5 des données
Colonne "A" Colonne "D"
263/01/2012/0001 15 000,00
263/01/2012/0001 8 000,00
263/01/2012/0001 6 000,00

donc dans la feuille de destination feuil2 colonne "D" j'aurais le total de 29 000,00

j’espère avoir été clair

merci encore une fois Ashireon
29/05/2013, 17h17
Fvandermeulen

Re,

Au vu du besoin, pourquoi pas un tableau croisé dynamique ?

A+
29/05/2013, 17h29
BERRACHED SAID

merci Fvandermeulen pour le conseil

mais sincèrement je n'ai jamais travaille avec les TCD et j'aime pas les TCD :lol:
peut être que c'est une question d'habitude.

de tout façon merci encore mon cher ami

en attendant de trouver un ébauche valable.

J'ai quelque chose d'equivalent et qui fonctionne dans une de mes macros

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
Sub recopie()
Dim DerniereLigne1 As Long
Dim DerniereLigne2 As Long
DerniereLigne1 = LastLigne("A", "Extraction")
 
Dim X As Integer
Dim Y As Integer
Dim Biblio
Application.ScreenUpdating = False
 
Set Biblio = CreateObject("Scripting.Dictionary")
' remplissage du dictionnaire trie avec une seul occurence
For Y = 11 To DerniereLigne1
    If Not Biblio.Exists(Sheets("Extraction").Range("C" & Y).Value) Then
        Biblio.Add Sheets("Extraction").Range("C" & Y).Value, Sheets("Extraction").Range("C" & Y).Value
    End If
 
Next
 
' recopies
Dim b As Long
Dim val As Variant
b = 1
For Each val In Biblio.items
   Sheets("Feuil2").Range("A" & b).Value = CStr(val)
    b = b + 1
Next
 
 
' calcul
 
DerniereLigne2 = LastLigne("A", "Feuil2")
For X = 1 To DerniereLigne2
    For Y = 11 To DerniereLigne1
        If Sheets("Feuil2").Range("A" & X).Value = Sheets("Extraction").Range("C" & Y).Value Then
            Sheets("Feuil2").Range("B" & X).Value = Sheets("Feuil2").Range("B" & X).Value + CDbl(Sheets("Extraction").Range("D" & Y).Value)
        End If
    Next
Next
 
Application.ScreenUpdating = True
Sheets("Feuil2").Select
End Sub
 
Public Function LastLigne(ByVal Colonne As String, ByVal Feuille As String) As Long
LastLigne = Sheets(Feuille).Range(Colonne & Rows.Count).End(xlUp).Row
 
End Function

30/05/2013, 10h21
BERRACHED SAID

1 pièce(s) jointe(s)

Bonjour le forum bonjour ashiron

voila j'ai essayé adapter le code que tu ma remis mais apparemment il donne pas le résultat escompté.

pour plus de compréhension je t'envois un fichier ou j'ai bien expliqué la démarche.

merci mon cher ami
30/05/2013, 10h59
Ashireon

1 pièce(s) jointe(s)

Voili voilou
Est ce que c'est bien ce que tu demandes :-)
30/05/2013, 11h17
BERRACHED SAID

salut ashieron

merci pour le coup de main mais j'aimerai savoir comment que dois-je exécuter la function.

j'aimerai exécuter le code par bouton commande.

merci
30/05/2013, 11h26
Ashireon

Il suffit de copier coller c'est une fonction VB Perso au meme titre que sommeprod classique
Elle ne fonctionne que pour la feuil 2 avec les references de la feuil 5 de ce classeur.
il suffit de faire = SOmmeProdPerso(A25)
30/05/2013, 14h54
BERRACHED SAID

Salut Ashireon

je viens de me concentrer sur la fonction que tu m'a remise elle donne le résultat escompté évidemment tout fait comme Sommprod Classique mais elle ne répond pas a mes souhaits pour la simple raison que le fichier orignal est fermé il fonction que par bouton et macro l’utilisateur n'a pas la main pour transcrire la fonction manuellement donc a priori je préféré un code qui excitera le travail j’espère que tu m"a compris.

merci et 1000 merci mon cher ami
30/05/2013, 14h59
Ashireon

je te modifie ca les references sur l'original sont les mêmes je suppose.
30/05/2013, 15h08
BERRACHED SAID

oui elle sont les mêmes
30/05/2013, 15h13
Ashireon

1 pièce(s) jointe(s)

Re voila avec un bouton dans le ruban complements

SommeprodPerso - Calcul

Il te suffira de copier les 2 modules dans ton classeur originale.
30/05/2013, 16h29
BERRACHED SAID

Salut

alors la Monsieur chapeau :ccool:

j'ai du modifier un peu mais ça marche a merveille c'est ce que je souhaité

merci Ashieron t'es vraiment fort.
30/05/2013, 16h37
Ashireon

Beuh non ici il y en a plein qui touche leu bille.
Je reste un bidouilleur du Dimanche :-) Mais c'est vrai que ça m'éclate de faire des modules en vba..