VBA excel différencier des doublons Résolu/Fermé

Question

Bonjour à tous, 

Encore une fois j'ai un gros problème qui nécessiterait vos lumières.

Je suis actuellement en train de faire un tableau de stock de matière première

dans la colonne A on trouve l'état des stocks de produits finis (les chiffres négatifs représentent un besoin d'appro, les chiffres positifs représentent les stocks dispo)
Dans la colonne B on trouve les référence des composants des produits finis (ce sont des numéros qui changent selon le composants).
Dans la colonne C on trouve le nom des composants.
Dans la colonne D on trouve les stocks de composant (les chiffres sont nuls ou positifs).
Et dans la colonne E j'ai déduit au préalable le nombre total de composant dans le stock en additionnant les données dans la colonne A avec les données dans la colonne D.

Le problème est que j'ai des composant qui apparaissent plusieurs fois car ils peuvent se retrouver dans différents produits finis. Je ne peux pas effacer les doublons car chacun corresdpond à état de stock de produit fini. Cependant ma dernière colonne est faussé car le stock de composant en premiere ligne additionné au stock de produit fini influent sur le stock de ce même composant s'il apparait une deuxième fois et ainsi de suite.

La macro suivante vous montrera concrètement ce que je faire

Sub stockCalcule()

Sheets("synthese").Select
Dim ligne As Integer
ligne = 2
Do

 
  If Sheets("synthese").Cells(ligne, 2).Value = Sheets("synthese").Cells(ligne + 1, 2).Value And Sheets("synthese").Cells(ligne, 3).Value = Sheets("synthesis").Cells(ligne + 1, 3).Value Then
    Sheets("synthese").Cells(ligne + 1, 4).Value = Sheets("synthese").Cells(ligne, 5).Value
 Je souhaite que la valeur de la cellule situé dans mon doublon colonne D soit égale à la valeur de la première ligne dans ma colonne E
  End If
Loop While Sheets("synthese").Cells(ligne + 1, 4).Value <> Sheets("synthese").Cells(ligne, 4).Value

End Sub

Je comprend pas pourquoi ça marche pas...

AU SECOURS!!!

melanie1324 · Answer

Bonjour,

tu as fait une erreur de frappe!!!

remplace :
If Sheets("synthese").Cells(ligne, 2).Value = Sheets("synthese").Cells(ligne + 1, 2).Value And Sheets("synthese").Cells(ligne, 3).Value = Sheets("synthesis").Cells(ligne + 1, 3).Value Then


par
If Sheets("synthese").Cells(ligne, 2).Value = Sheets("synthese").Cells(ligne + 1, 2).Value And Sheets("synthese").Cells(ligne, 3).Value = Sheets("synthese").Cells(ligne + 1, 3).Value Then

après le end tu lui demandes de rechercher dans la feuille synthesis mais je suppose que c'est synthèse non?

pijaku · Answer

Bonjour, 
1- Do While "sur place" : 
ligne = 2 
Do 
Bla bla 
ligne = ligne + 1 
While
Dans ta "boucle" Do While, tu ne changes pas la valeur de ligne. Donc tu boucle sur la ligne 2.... 

2- Je souhaite que la valeur de la cellule situé dans mon doublon colonne D soit égale à la valeur de la première ligne dans ma colonne E 
C'est toi qui le dis... 
Ton code dis : si égal à la cellule E2 : 
Sheets("synthese").Cells(ligne, 5).Value  
à remplacer donc, il me semble par : Sheets("synthese").Cells(2, 5).Value 

N'est il pas? 
Cordialement, 
Franck P

llecarpentier · Answer

Merci pour vos réponses!!

A vrai dire Pijaku, je me suis mal exprimé. je voulais dire la première ligne du doublon.

llecarpentier · Answer

Désolé de ne pas avoir répondu plus tôt mais j'avais des choses importantes à regler.
Tout d'abord je vous remercie pour votre aide. Les erreurs sont corrigées.
Malheureusement depuis hier après midi le problème a changé.

Tout d'abord je ne dois remplir les cellules de ma colonne E que si les cellules situées sur la même ligne dans ma colonne A sont négative. J'en ai donc déduit la macro suivante qui fonctionne:

Sheets("synthese").Select
Dim ligne As Integer
ligne = 2
Do
If Sheets("synthese").Cells(ligne, 1) < 0 Then
Sheets("synthesis").Cells(ligne, 5) = Sheets("synthesis").Cells(ligne, 1) + Sheets("synthesis").Cells(ligne, 4)
End If

ligne = ligne + 1
Loop Until Cells(ligne, 2) = ""

End Sub

Le problème est que maintenant j'ai des cellules vide dans ma colonne E et la macro que j'ai faite pour additionner les valeurs incluses dans mes doublons ne fonctionne plus.
J'ai par conséquent décider d'en faire une autre mais l'effet n'est pas celui escompté puisque la macro ne s'arrête pas (normal vu que je ne sais pas quelle condition poser pour l'arrêter) et qu'elle n'agie que sur mon premier doublon situé aux lignes 3 et 4.

Autant vous dire que je désespère.

La macro est la suivante:

Sub SoustractionBom()

Sheets("synthese").Select
Dim ligne As Integer
ligne = 2
Do
  If Cells(ligne, 2) = Cells(ligne + 1, 2) And Cells(ligne, 3) = Cells(ligne + 1, 3) Then
    Cells(ligne + 1, 4) = Cells(ligne, 4) + Cells(ligne, 1)
  Else
    ligne = ligne + 1
  End If
Loop

End Sub
Auriez vous une solution pour cette dernière macro?
Est-il possible de combiner les deux macro?

Merci d'avance pour vos réponses.

melanie1324 · Answer

Bonjour,

essaie ca et dis moi ce qu'il en est :

Sub SoustractionBom()

Sheets("synthese").Select
Dim ligne As Integer
ligne = 2
Do while cells(ligne,1) <> ""
If Cells(ligne, 2) = Cells(ligne + 1, 2) And Cells(ligne, 3) = Cells(ligne + 1, 3) Then
Cells(ligne + 1, 4) = Cells(ligne, 4) + Cells(ligne, 1)
Else
ligne = ligne + 1
End If
Loop

End Sub

llecarpentier · Answer

Ca ne marche pas...

Cela dit j'ai l'impression que la macro se bloque sur le deuxième doublon dans lequel le stock dans la colonne D est égal à zéro. Peut être que le problème vient du fait que quand la valeur est égale à zéro, celle ci est effacée...

Vous en pensez quoi?

melanie1324 · Answer

Bonjour,

que je suis bête, je viens de trouver pourquoi :

Sub SoustractionBom()

Sheets("synthese").Select
Dim ligne As Integer
ligne = 2
Do while cells(ligne,1) <> ""
If Cells(ligne, 2) = Cells(ligne + 1, 2) And Cells(ligne, 3) = Cells(ligne + 1, 3) Then
Cells(ligne + 1, 4) = Cells(ligne, 4) + Cells(ligne, 1)
end if
ligne = ligne + 1

Loop

End Sub

llecarpentier · Answer

Miracle!!!!
Ca fonctionne au poil!!!

Merci beaucoup.