Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

[julien974]

Bonjour le forum,

J'ai conçu une macro pour effectuer mon classement ABC de produits ds mon stock.
Je débute en VBA mais j'ai quand même réussi à faire quelque chose qui tourne. Mais ma macro ne fonctionne plus alors que je n'ai rien touché, c'est à n'y rien comprendre. Je vous mets le code ci dessous.

De plus pensez vous qu'il serait possible d'améliorer ce code pour une plus grande exécution de la macro?

Sub rotations()
    
    
   'ROTATIONS
   'J'aimerai ici supprimer tout sauf la première ligne
    Sheets("Maj rot.").Select
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
   
   'Copier coller des colonnes de données dans le feuille d'analyse
    Sheets("Base EP").Select 'problème à ce niveau "Execution interrompue"
    Columns("A:G").Select
    Selection.Copy
    Sheets("Maj rot.").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    'Tri décroissant
    
    ActiveSheet.UsedRange.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("G2"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    
    'Classement ABC (Loi de PARETO 80/20)
    
    Range("H2").Select
    Range("H2").FormulaR1C1 = "=VLOOKUP(RC[-5],MATRICECONTENANTS,4,0)"
    Range("H2").Offset(0, 1).FormulaR1C1 = "=RC[-4]/RC[-1]"
    Range("H2:I" & Range("A65536").End(xlUp).Row).FillDown
    
    ActiveSheet.UsedRange.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
    Range("J2").FormulaR1C1 = "=RC[-1]"
    Range("J3").FormulaR1C1 = "=RC[-1]+R[-1]C"
    Range("J3:J" & Range("A65536").End(xlUp).Row).FillDown

    Dim Ligne As Long
    Ligne = ActiveSheet.Range("A65536").End(xlUp).Row + 1
    ActiveSheet.Range("I" & Ligne).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
    ActiveSheet.Range("I" & Ligne).Name = "hihi"
    
    Range("K2").FormulaR1C1 = "=RC[-1]/hihi"
    Range("K2:K" & Range("A65536").End(xlUp).Row).FillDown
    
    Dim Ligne2 As Long
    Ligne2 = ActiveSheet.Range("A65536").End(xlUp).Row + 1
    ActiveSheet.Range("E" & Ligne2).FormulaR1C1 = "=COUNTA(R2C:R[-1]C)-1"
    ActiveSheet.Range("E" & Ligne2).Name = "haha"
    
    Range("L2").FormulaR1C1 = "=1/haha"
    Range("L2:L" & Range("A65536").End(xlUp).Row).FillDown
    
    Range("M2").FormulaR1C1 = "=RC[-1]"
    Range("M3").FormulaR1C1 = "=RC[-1]+R[-1]C"
    Range("M3:M" & Range("F65536").End(xlUp).Row).FillDown
    
    Range("N2").FormulaR1C1 = "=IF(RC[-3]="""","""",IF(RC[-3]<=0.8,""A"",IF(RC[-3]>=0.95,""C"",""B"")))"
    Range("N2:N" & Range("A65536").End(xlUp).Row).FillDown
    
    End Sub

Merci de votre aide,

Juli3n974

 

[jp14]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

Bonjour

Quand on utilise l'enregistreur de macro, modifier la macro ne pose pas trop de problème.
Par contre vérifier si la macro fonctionne quand on n'a pas d'exemple des données que la procédure manipule est plus problématique.

Un fichier avec la macro et des données non confidentielles permettrait de trouver plus facilement les problèmes et la manière d'y remédier.


JP

 

[Staple1600]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

Bonsoir

Un conseil:
Supprimer tout ce qui rapproche d'une Selection

Exemple avec le début de ton code

'J'aimerai ici supprimer tout sauf la première ligne
    Sheets("Maj rot.")Rows("2:2").Range(Selection, Selection.End(xlDown)).Delete Shift:=xlUp

Ou plus simple

Sub autre_facon_effacement()
Rows("2:65536").Delete
End Sub

 

[Staple1600]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

Re

A tester dans ton classeur (en changeant les noms des feuilles)

Sub rotations_bis()
Dim Ligne As Long
Dim Ligne2 As Long
Dim ws As Worksheet
Set ws = Sheets(1)
   'ROTATIONS
   'J'aimerai ici supprimer tout sauf la première ligne
    fin = ws.UsedRange.Rows.Count
    Rows("2:" & fin).Delete
'   'Copier coller des colonnes de données dans le feuille d'analyse
    Sheets(2).Columns("A:G").Copy ws.Range("A1")
'    'Tri décroissant
With ws
    .UsedRange.Sort Key1:=Range("G2"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ', DataOption1:=xlSortNormal
'    'Classement ABC (Loi de PARETO 80/20)
    .Range("H2").FormulaR1C1 = "=VLOOKUP(RC[-5],MATRICECONTENANTS,4,0)"
    .Range("H2").Offset(0, 1).FormulaR1C1 = "=RC[-4]/RC[-1]"
    .Range("H2:I" & Range("A65536").End(xlUp).Row).FillDown
    .UsedRange.Sort Key1:=Range("I2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False ', Orientation:=xlTopToBottom, 'DataOption1:=xlSortNormal
    .Range("J2").FormulaR1C1 = "=RC[-1]"
    .Range("J3").FormulaR1C1 = "=RC[-1]+R[-1]C"
    .Range("J3:J" & Range("A65536").End(xlUp).Row).FillDown
Ligne = .Range("A65536").End(xlUp).Row + 1
    .Range("I" & Ligne).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
    .Range("I" & Ligne).Name = "hihi"
    .Range("K2").FormulaR1C1 = "=RC[-1]/hihi"
    .Range("K2:K" & Range("A65536").End(xlUp).Row).FillDown
Ligne2 = .Range("A65536").End(xlUp).Row + 1
    .Range("E" & Ligne2).FormulaR1C1 = "=COUNTA(R2C:R[-1]C)-1"
    .Range("E" & Ligne2).Name = "haha"
    .Range("L2").FormulaR1C1 = "=1/haha"
    .Range("L2:L" & Range("A65536").End(xlUp).Row).FillDown
    .Range("M2").FormulaR1C1 = "=RC[-1]"
    .Range("M3").FormulaR1C1 = "=RC[-1]+R[-1]C"
    .Range("M3:M" & Range("F65536").End(xlUp).Row).FillDown
    .Range("N2").FormulaR1C1 = "=IF(RC[-3]="""","""",IF(RC[-3]<=0.8,""A"",IF(RC[-3]>=0.95,""C"",""B"")))"
    .Range("N2:N" & Range("A65536").End(xlUp).Row).FillDown
End With
End Sub

 

[MichelXld]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

bonsoir

une autre solution sans macro :

Créer un diagramme de Pareto dans Excel - Club d'entraide des développeurs francophones

bonne soirée
michel
Microsoft Excel MVP

 

[julien974]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

Merci bcp,

Je regarde tout ça et je vous tiens au courant demain,

Bonne soirée,

Juli3n974

 

[p.dell]

Re : Classement ABC (PARETO, 80/20) - Problème VBA + Simplification

Je suis Etudiante en Logistique en région parisienne. Je cherche un programme VBA sur la classification ABC ( Pareto ). Je suis vraiment débutante dans ce domaine et je ne maîtrise pas du tout la programmation sur VBA. Je vous prie de bien vouloir m'aider car je suis bloquée.
Merci de votre compréhension.