regrouper des références dans plusieurs nomenclatures

Question

Bonjour, Je suis débutant dans VBA , j'ai créé une macro pour les nomenclatures de composant électronique ou autres. (1 nomenclature est équivalent à 1 kit de montage où nous avons plusieurs pièces pour sa fabrication) par exemple : pour fabriquer 1 voiture (=1 produit) je vais devoir commander chaque pièce (=référence) nécessaire à sa fabrication ( 4 roues, 1 moteur, 4 jantes, etc) si je fabrique plusieurs modèles de voitures il se peut que certaines voitures ont les même roues Donc ma macro regroupe ces références identiques après avoir demandé le nom du produit et la quantité de ce produit à fabriquer Questions: 1- Pourriez-vous me dire quels sont mes erreurs car je me sers souvent de l'enregistreur pour mes macros? 2- Comment améliorer cette macro ? 3- Pouvons-nous créer un dico ou une base de données qui contiendrait tous ces produits? ( à savoir que nous pouvons avoir plus de 100 produits et chaque produit peut contenir plus de 40 références donc gros fichiers) 4 - comment éviter les erreurs de frappe? (dans ma macro pas protégé pour ça) Comment fait-on pour joindre un fichier Excel avec les macros sur votre site? Merci Sub cumul_Reference() ' cumul_produit Macro ' Dim Nom_du_Produit As String Nom_du_Produit = InputBox("Saisir le nom du produit à commander ", "Nomenclature", " seulement: prod01 à prod10") ' demande à sasir le produit à rechercher Qté_du_Produit = InputBox("Quantité du " & Nom_du_Produit) ' demande la quantité de produit à fabriquer If Nom_du_Produit = "" Then ' si pas de sasie MsgBox ("vous n'avez rien saisi !") Exit Sub reponse = MsgBox(" Voulez-vous vraiment quitter?", vbQuestion + vbOKCancel) If reponse = vbOK Then 'PROBLEME: si on saisie "annuler" une fois puis ensuite "ok " la macro de s'arrete pas et m'indique erreur "9" Exit Sub Else Call cumul_Reference ' sinon continu End If End If compteur = 1 ' sélectionne la feuille du produit demandé (prod01 à prod10) Sheets(Nom_du_Produit).Select Finligne = ActiveSheet.UsedRange.Rows.Count Range("A2:F" & Finligne).Select Selection.Copy ' active la feuille "cumul_Reference" et colle le prodduit Sheets("cumul_Reference").Select FinligneF = ActiveSheet.UsedRange.Rows.Count + compteur Range("A" & FinligneF).Select ActiveSheet.Paste FinligneFormule = ActiveSheet.UsedRange.Rows.Count + 1 numeroligne = FinligneF While numeroligne < FinligneFormule Range("F" & numeroligne).Select ' inscrit en "F" la formule "qté du produit x coef. = cellule A * cellule E)" ActiveCell.FormulaR1C1 = "=" & Qté_du_Produit & "*RC[-1]" Range("A" & numeroligne).Select ActiveCell.FormulaR1C1 = Qté_du_Produit numeroligne = numeroligne + 1 Wend Finligneb = ActiveSheet.UsedRange.Rows.Count + 1 ' cumul_References Range("A" & Finligneb).Select ' cumul_References Call cumul_Reference compteur = compteur + 1 End Sub Sub tri() ' Bordure en trait fin + tri par référence + somme des références identiques Application.ScreenUpdating = False FinligneT = ActiveSheet.UsedRange.Rows.Count Range("A2:F" & FinligneT).Select ' Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlHairline End With ' tri par référence (colonne C) ' Sheets("cumul_Reference").Select FinligneT = ActiveSheet.UsedRange.Rows.Count Range("A3:F" & FinligneT).Select Application.CutCopyMode = False ActiveWorkbook.Worksheets("cumul_Reference").Sort.SortFields.Clear ActiveWorkbook.Worksheets("cumul_Reference").Sort.SortFields.Add Key:=Range( _ "C2:C" & FinligneT), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("cumul_Reference").Sort .SetRange Range("A1:F" & FinligneT) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Somme des références identiques ' FinLigneN = ActiveSheet.UsedRange.Rows.Count Range("A2:F" & FinLigneN).Select ' ActiveWorkbook.Worksheets("cumul_Reference").Sort.SortFields.Clear ActiveWorkbook.Worksheets("cumul_Reference").Sort.SortFields.Add Key:=Range( _ "C2:C" & FinLigneN), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("cumul_Reference").Sort .SetRange Range("A1:F" & FinLigneN) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(6), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ' eface_les_2_derniere_lignes Macro FinLigneCalcul = ActiveSheet.UsedRange.Rows.Count Range("A" & FinLigneCalcul - 1 & ":F" & FinLigneCalcul).Select Selection.EntireRow.delete ' séparateur des milliers Columns("F:F").Select Selection.NumberFormat = "#,##0" Application.ScreenUpdating = True 'Largeur des colonnes auto Columns("A:F").Select Selection.Columns.AutoFit Range("G4").Select End Sub Sub efface_croise() ' ' efface_croise Macro ' Selection.RemoveSubtotal Range("G7").Select End Sub Sub raz() 'efface lignes Range("A3").CurrentRegion.Offset(2, 0).Clear End Sub Geoffroy

Patrice33740 · Answer

Bonjour,

Tu pourrais commencer ton code comme ceci :
Sub cumul_Reference()
' cumul_produit Macro
'
Dim wsh As Worksheet
Dim nom_du_Produit As String
Dim qté_du_Produit As Long
Dim réponse As Integer
                
Do
  nom_du_Produit = InputBox("Saisir le nom du produit à commander ", "Nomenclature", "seulement: prod01 à prod10")
  If nom_du_Produit = "" Then Exit Sub
  qté_du_Produit = InputBox("Quantité du " & nom_du_Produit, "Quantité", 1)
  If qté_du_Produit = 0 Then Exit Sub
  'sélectionne la feuille du produit demandé (prod01 à prod10)
  On Error Resume Next
  Set wsh = Worksheets(nom_du_Produit)
  On Error GoTo 0
  If wsh Is Nothing Then
    réponse = MsgBox("Le produit demandé :" & vbCr & vbCr & _
                     nom_du_Produit & vbCr & vbCr & _
                     "n'existe pas !" & vbCr & vbCr & vbCr & _
                     "Voulez-vous continuer ?", vbQuestion + vbYesNo)
    If réponse = vbNo Then Exit Sub
    nom_du_Produit = ""
  End If
Loop While nom_du_Produit = ""

'Pour la copie des données, il faudrait un exemple du fichier ...
 
End Sub
 
Pour joindre un fichier tu peux aller sur http://cjoint.com/
et revenir ici mettre le lien fourni.

Patrice33740 · Answer

Bonjour,

Je ne comprends pas la démarche, ça manque d'explications ! 
Pourquoi autant d'onglets ? Quel est le rôle de chacun ?

1- Peut-on créer une base de données ou un dico qui contiendrait tous ces produits?
Oui, mettre tous les références dans un même onglet

2- comment éviter les erreurs de saisie, par exemple si on ne tape pas le bon produit ou si on tape des chiffres ou autres?
Vouloir éviter les erreurs de saisie est utopique, on peut les limiter au prix d'une perte de souplesse mais en général, il suffit d'un message d'erreur lorsque la saisie n'est pas correcte (produit inconnu)

3- Si nous saisissons des données dans une feuille Excel par exemple dix lignes et que nous les supprimons,  ces lignes existent toujours. comment supprimer vraiment ces lignes?
Non : quand on supprime des lignes elle n'existent plus !!!
mais, peut-être ne les supprimes tu pas.

4- Peut-on faire plus simple car je me sers beaucoup de l'enregistreur ,pour  simplifier ma macro?
Oui, le principal défaut du code généré par l'enregistreur est de comporter de nombreux "Select" totalement inutiles. Le premier travail consiste donc à supprimer tous les Select générés par l'enregistreur (L'utilisation de Select n'est que très exceptionnellement nécessaire)

Utilisateur anonyme · Answer

Bonjour,

Désolé je m'exprime très mal...

Un onglet est représenté par un produit que j'ai nommé prod01, prod02 ... à prod10 pour essayer de faire simple j'en ai mis que 10.

Dans chaque produit tu trouveras plusieurs lignes qui représentent les pièces pour sa fabrication.
Les pièces sont représentées par des références.

Un produit est équivalent à un kit de montage par exemple pour monter une voiture il faut 4 roues, 1 carrosserie, 1 moteur, 1 volant,  etc.

Quand nous saisissons 500 prod01, 1000 prod02 et 2000 prod10
nous allons trouver des références identiques et le but de la macro c'est de les regrouper afin de savoir la quantité exacte de chaque référence pour les commander.

Oui les lignes supprimées, le contenu n'existe plus mais si j'ai 101 lignes et que je supprime 100 lignes de A2 à A101.
Le contenu disparait mais si je fais CTRL+fin mon curseur va à la ligne 101 et non à la ligne 1  . Donc dans mon VBA de 'fin de ligne' est faussée quand je fais un RAZ, car les saisies vont redémarrer à la ligne 102 ...

Comment y remédier? 

Les dico je ne sais absolument pas comment on fait .
si tu as un lien où je pourrais m'informer je suis preneur car je n'ai encore rien trouvé.

j'espère avoir été un peu plus clair?

merci

cordialement
Geoffroy

ucfoutu · Answer

Bonjour,
Oui les lignes supprimées, le contenu n'existe plus mais si j'ai 101 lignes et que je supprime 100 lignes de A2 à A101.
Le contenu disparait mais si je fais CTRL+fin mon curseur va à la ligne 101 et non à la ligne 1 . Donc dans mon VBA de 'fin de ligne' est faussée quand je fais un RAZ, car les saisies vont redémarrer à la ligne 102 ...
Si les lignes ont bien été suprimées et que d'autres lignes en dessous ne contiennent ni formatage, ni cellules ===>>
ActiveSheet.UsedRange
devrait remettre en place les choses

Patrice33740 · Answer

Re,

« Oui les lignes supprimées, le contenu n'existe plus mais si j'ai 101 lignes et que je supprime 100 lignes de A2 à A101.
Le contenu disparait mais si je fais CTRL+fin mon curseur va à la ligne 101 et non à la ligne 1 »
 
Non, les lignes n'ont pas été supprimées mais simplement effacées!
la commande pour supprimer des lignes c'est :
Rows(meslignes).Delete

Utilisateur anonyme · Answer

Bonjour,
Merci Ucfoutu, j'ai essayé et ça fonctionne super

Merci Patrice je vais essayer aussi.
super sympa de répondre  :)


cordialement 
Geoffroy

Regrouper des références dans plusieurs nomenclatures

6 réponses

Votre réponse

Discussions similaires