Insertion de lignes avec recherche

[strassup]

Bonjour à tout(e)s,

Je me permets de revenir vers vous, désepéré de ne pas trouver de solution à mon problème (je ne suis qu'un débutant en Macros).

Les données sont les suivantes:
- J'extrais des données (onglet DONNEES), que j'ai simplifié pour l'exercice. On y trouve des collonnes : Clients, N° de Facture, N° d'article, tous trois avec doublons. D'autres données les complètent: CA, Tarif, Marge

- J'automatise ensuite (onglet TABLEAU INTERMEDIAIRE) la suppression des doublons, le cumul du CA et de la marge, pour obtenir un taux de marge moyen par client.

- Ensuite vient mon point de bloquage : J’aimerais renvoyer (onglet SYNTHESE) les clients ayant moins de 25% de marge globale de l’onglet TABLEAU INTERMEDIAIRE en ajoutant la liste des articles vendus à ce client. (je l’ai fais ici manuellement en filtrant dans l’onglet DONNES les N° de clients, en copiant puis en collant dans l'onglet SYNTHESE…pour vous montrer à quoi je voudrais arriver).

NB : je ne tiens pas à conserver mon onglet intermédiaire, ni une quelconque mise en forme dans le tableau final.

Bonus 1 : insérer des sous totaux par client dans le tableau final
Bonus 2 : sommer les articles répétés par client (comme je l’ai fait manuellement)


Le cœur de mon problème, vous l’aurez compris, est de renvoyer les numéro de clients concernés par le critère des –25% et de copier à la bonne place les lignes concernées de la base de donnée.

Si vous avez une piste à me proposer, je vous en serais fort gré.

Merci d’avance.

Cordialement
Strassup.

 

[jetted]

Re : Insertion de lignes avec recherche

Bonjour

Voici un peu de code pour te demarrer

Sub main()
    Sheets("DONNEES").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    For r = 2 To RowCount
        Sheets("DONNEES").Select
        Range("G" & r).Select
        marge = ActiveCell.Value
        Range("E" & r).Select
        ca = ActiveCell.Value
        txmarge = (marge / ca)
        txmarge = Round(txmarge, 2)
        If txmarge < 0.26 Then
            Rows(r).Copy
            Sheets("SYNTHESE").Select
            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
            Range("A" & RowCount + 1).PasteSpecial (xlPasteValues)
            Range("H" & RowCount + 1).Select
            ActiveCell.Value = txmarge 
        End If
     
     Next r
Call totalise    
End Sub

Sub totalise()
Sheets("SYNTHESE").Select
MsgBox "A venir pour les totaux par clients"
End Sub

 

[Bebere]

Re : Insertion de lignes avec recherche

bonjour Strassup,Jetted
pas bien compris, mais tu as les clients avec -de 25% dans synthèse ligne 20
à bientôt

 

[jetted]

Re : Insertion de lignes avec recherche

Voici une version amelioree, il reste seulement a calculer la feuille synthese

Sub main()
    Sheets("DONNEES").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    For r = 2 To RowCount
        Sheets("DONNEES").Select
        Range("G" & r).Select
        marge = ActiveCell.Value
        Range("E" & r).Select
        ca = ActiveCell.Value
        txmarge = (marge / ca)
        txmarge = Round(txmarge, 2)
        If txmarge < 0.26 Then
            Rows(r).Copy
            Sheets("SYNTHESE").Select
            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
            Range("A" & RowCount + 1).PasteSpecial (xlPasteValues)
            Range("H" & RowCount + 1).Select
            ActiveCell.Value = txmarge
        End If

    Next r
    Call sort
    Call totalise
End Sub

Sub totalise()
    Sheets("SYNTHESE").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    For L = RowCount To 3 Step -1
        Range("a" & L).Select
        var1 = Range("a" & L - 1).Value
        Range("a" & L - 1).Select
        var2 = Range("a" & L).Value
        If var1 <> var2 Then
            a = ActiveCell.Row
'           MsgBox a
            Range("a" & a).Select
            ActiveCell.Offset(1).EntireRow.Insert
'            Range("A" & a + 3).Select
'            ActiveCell.Value = "Total"
'            ActiveCell.Offset(rowOffset:=0, columnOffset:=4).Activate
        End If
    Next L
End Sub

Sub sort()
    Sheets("SYNTHESE").Select
    Range("a2").Select
    Application.CutCopyMode = False
    Selection.sort Key1:=Range("a2"), Order1:=xlAscending, Header:=xlYes, _
                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    ' Selection.AutoFilter
End Sub

 

[Bebere]

Re : Insertion de lignes avec recherche

bonjour Strassup,Jetted
dans module1,le 1er code
nouveau code plus complet(j'ai compris en consultant le code de Jetted) dans module3
dans module2 le code(main) de Jetted amélioré(rapidité)
à bientôt

 

[pierrejean]

Re : Insertion de lignes avec recherche

bonjour a tous

un essai

 

[strassup]

Re : Insertion de lignes avec recherche

Bonjour à tous,
Merci pour tant de propositions !!!
Confronter tout ça à mes essais et voire ce que cela donne.
Je reviens vers vous pour vous dire comment ça à été.

Cordialement.

Strassup