Insertion d'une ligne sous condition [Résolu]

Nono89

XLDnaute Nouveau
Bonjour le forum,

J'aurai besoin de conseil avisé, voici mon problème :

Sur un onglet Excel j'ai l'information des clients visités pour un commercial.
Le commercial peu vendre plusieurs familles à un client (dans ce cas il ya une ligne pour chaque ensemble "client-famille")

J'ai le numéro client en colonne B et je cherche par rapport à cette info, chaque fois qu’une valeur est différente de la valeur suivante à insérer une ligne entre les deux valeurs.

Ca j'en suis pas trop loin mais déjà je bloque :

Sub test_initial()
Dim i As Long
Dim truc As Range
Set truc = Range("B2")
i = 1
With truc
While .Cells(i) <> Empty
If .Cells(i) = .Cells(i + 1) Then
i = i + 1
Else
Rows(i + 1).Insert Shift:=xlDown (il y a un problème à cette ligne)
i = i + 2
End If
Wend
End With
End Sub


Et en plus dans cette ligne insérer je voudrais mettre des informations
- en colonne B insérer : "Total"N°client
- en colonne J et K insérer : un sous total
- En colonne N et O une fonction si par rapport respectivement à ce qu'il y a en cellule J et K

Exigeant le gars xD

Voici un fichier (vu que mes explications sont pas forcément très claire)
Il y a 2 onglet : ce que j'ai au départ (onglet "initial") et ce que je voudrais obtenir (onglet "final")


Est il possible de faire ça?

Si quelqu'un a des pistes ou des conseils je suis preneur





Merci d'avance

Nono89
 

Pièces jointes

  • exemple.xlsx
    15.4 KB · Affichages: 75
  • exemple.xlsx
    15.4 KB · Affichages: 77
  • exemple.xlsx
    15.4 KB · Affichages: 77
Dernière édition:

Grand Chaman Excel

XLDnaute Impliqué
Re : Insertion d'une ligne sous condition

Bonjour Nono89,

Voici une piste pour commencer, il manque les 2 formules pour les colonnes N et O.
Je dois malheureusement quitter et ne peut pas terminer cette partie...

En espérant que ça t'aidera un peu...

VB:
Sub toto()

    Dim i As Long
    Dim rg As Range
    Dim rgdep As Range
    
    Set rg = Range("B3")
    Set rgdep = Range("b2")
    
    Do Until IsEmpty(rg.Offset(-1,0))
        If rg.Offset(-1, 0) <> rg Then
            rg.EntireRow.Insert xlDown
            rg.Offset(-1, 0) = "Total " & rg.Offset(-2, 0)
            rg.Offset(-1, 8) = Application.WorksheetFunction.Subtotal(9, rgdep.Offset(0, 8).Resize(rg.Row - rgdep.Row, 1))
            rg.Offset(-1, 9) = Application.WorksheetFunction.Subtotal(9, rgdep.Offset(0, 9).Resize(rg.Row - rgdep.Row, 1))
            rg.Offset(-1, 12).FormulaR1C1 = "..."   ' à compléter
            rg.Offset(-1, 13).FormulaR1C1 = "..."   ' à compléter
            
            Set rgdep = rg
        End If
        Set rg = rg.Offset(1, 0)
    Loop
End Sub

A+
 

Nono89

XLDnaute Nouveau
Insertion d'une ligne sous condition

Merci pour la rapidité de ta réponse Grand Chaman
et quelle efficacité le code marche niquel!!

Il faut que je regarde le code pour pour tenter de comprendre, vu mon niveau je pense que je redemanderais des explication (des parties me paraissent bien obscure notamment la formule sous total)

Du coup je vais voir pour la fonction "si" en me basant sur le fonctionnement pour l'écriture du sous total.


De quoi m'occuper encore un peu ^^



A+
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Insertion d'une ligne sous condition

Bonjour Nono89,

Alors voici le code terminé et commenté.
N'hésite pas à poser des questions au besoin.

VB:
Sub toto()

    Dim i As Long
    Dim rg As Range
    Dim rgdep As Range
    
    Application.ScreenUpdating = False
    
    Set rg = Range("B3")
    Set rgdep = Range("B2")     'plage de référence pour le sous-total (1re ligne)
    
    Do Until IsEmpty(rg.Offset(-1, 0))
        If rg.Offset(-1, 0) <> rg Then
            rg.EntireRow.Insert xlDown      'insère une ligne
            
            rg.Offset(-1, 0) = "Total " & rg.Offset(-2, 0)
            ' Note :
            ' Application.WorksheetFunction.xxx permet d'utiliser une fonction normale dans Excel (exemple: Min, Max, SousTotal, ...)
            ' et renvoie directement le résultat
           ' rg.Offset(-1, 8) = Application.WorksheetFunction.Subtotal(9, rgdep.Offset(0, 8).Resize(rg.Row - rgdep.Row, 1))
           ' rg.Offset(-1, 9) = Application.WorksheetFunction.Subtotal(9, rgdep.Offset(0, 9).Resize(rg.Row - rgdep.Row, 1))
            '
            ' Si on veut plutôt avoir la formule dans la cellule, il faut alors utiliser .FormulaR1C1
            ' voir l'aide à ce sujet. Ici, on travaille avec RC[-x]:RC[-1] pour définir la plage du sous-total
            ' on se sert de la ligne de rgDep pour savoir où commencer
            rg.Offset(-1, 8).FormulaR1C1 = "=SUBTOTAL(9,R[-" & rg.Row - rgdep.Row - 1 & "]C:R[-1]C)"
            rg.Offset(-1, 9).FormulaR1C1 = "=SUBTOTAL(9,R[-" & rg.Row - rgdep.Row - 1 & "]C:R[-1]C)"
            rg.Offset(-1, 12).FormulaR1C1 = "=if(RC3="""",if(RC10>0,1,""""),"""")"
            rg.Offset(-1, 13).FormulaR1C1 = "=if(RC3="""",if(RC11>0,1,""""),"""")"
            
            rg.Offset(-1, 0).EntireRow.Font.Bold = True     'ligne en gras
           
            Set rgdep = rg
        End If
        Set rg = rg.Offset(1, 0)
    Loop
    
    Application.ScreenUpdating = True
End Sub

A+
 

Nono89

XLDnaute Nouveau
Insertion d'une ligne sous condition

Merci pour le temps que tu as du passé la-dessus, le code fonctionne à merveille

Si je comprend bien:
- rg.offset(x,y) => x fait référence à la ligne et y à la colonne, avec comme référence de base la cellule B3

- Pour la formule ("si" en l’occurrence) RC représente les références relatives et comme on se déplace uniquement horizontalement les valeurs RC3 fait référence à 3 colonnes à gauche de celle ou se trouvera la formule.


De plus je me permet d'abuser et de redemander un conseil conernant les références :

pour moi c’est le nœud du problème résides dans les références. En effet à partir de ce joli morceau de code, j’ai par le biais de l’enregistreur de macro j'ai inséré une ligne « Total Général » qui permet de faire le total de chacune des colonnes de J à O via l’enregistreur de macro.
(il ya surement meilleur présentation pour les puriste mais en dehors du problème des totaux il fonctionne très bien)

Le souci c'est que cette formulation ne prend pas en compte la longueur variable de la base
Mais si tu as une idée pour le total je suis preneur car :
- les références relatives me détermine juste une "longueur" de cellule à prendre en compte (ici 50 cellule au dessus)
- si j'utilise Ctrl + haut ça ne fonctionne pas non plus car toutes les cellules de la colonne ne sont pas remplies

Il m'a donné le code suivant pour les totaux


'Aller a la dernière cellule utilisée
ActiveCell.SpecialCells(xlLastCell).Select

'inscription "Total Général" sous le dernier total par client
ActiveCell.Offset(1, -13).Range("A1").Select
ActiveCell.FormulaR1C1 = "Total Général"

'Calcul du total CA 11 en colonne J (première cellule non vide)
ActiveCell.Offset(0, 8).Range("A1").Select
Selection.FormulaR1C1 = "=SUBTOTAL(9,R[-50]C:R[-1]C)"

'Calcul du total CA 12 en colonne K (première cellule non vide)
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=SUBTOTAL(9,R[-50]C:R[-1]C)"

' Calcul du total colonne L (fam act 11)
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=SUM(R[-50]C:R[-1]C)"

' Calcul du total colonne M (fam act 12)
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=SUM(R[-50]C:R[-1]C)"

' Calcul du total colonne N
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=SUM(R[-50]C:R[-1]C)"

' Calcul du total colonne O
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=SUM(R[-50]C:R[-1]C)"


Ce que je fais ensuite pour calculer un ratio à partir de ces totaux, je sais que les références relatives permettent de répondre à mon attente mais la ligne totale c'est une autre affaire

Je joins un fichier au cas où pour clarifier mes explications
 

Pièces jointes

  • Exemple.xlsm
    29.4 KB · Affichages: 75
  • Exemple.xlsm
    29.4 KB · Affichages: 74
  • Exemple.xlsm
    29.4 KB · Affichages: 72

Grand Chaman Excel

XLDnaute Impliqué
Re : Insertion d'une ligne sous condition

Bonjour Nono89,

Voici quelques explications :

rg.offset(x,y) => x fait référence à la ligne et y à la colonne, avec comme référence de base la cellule B3

rg.offset(x,y) décale de X ligne et Y colonne la plage RG.
Ici, on commence par définir RG = B3 et ensuite on le décale de 1 ligne à la fin de la boucle.
C'est donc un décalage à partir de la colonne B à chaque fois.

- Pour la formule ("si" en l’occurrence) RC représente les références relatives et comme on se déplace uniquement horizontalement les valeurs RC3 fait référence à 3 colonnes à gauche de celle ou se trouvera la formule.

Voici quelques exemple pour comprendre la notation R1C1
R1C1 : référence absolue à la cellule A1 (= $A$1)
R[-1]C : référence relative : une ligne avant, même colonne
RC[2] : référence relative : même ligne, 2 colonnes à droite
R3C[-2]: référence mixte : 3e ligne, 2 colonnes à gauche
R2C:R[-1]C : Plage partant de la ligne 2, dans la même colonne, jusqu'à la cellule située une ligne au-dessus de la cellule active, dans la même colonne.

Pour ce qui est de ton total général, tu peux le calculer en sachant que tu commences toujours à la ligne 2 jusqu'à la ligne X. Il suffit de trouver la ligne X qui est la dernière de ta base de données. Voir le code dans le Module1 pour mieux comprendre.

PS : évite les .Select dans ton code car ça le ralentit. L'enregistreur automatique de macro en ajoute un tas pour rien...

A+
 

Pièces jointes

  • Exemple2.xlsm
    33.4 KB · Affichages: 60
  • Exemple2.xlsm
    33.4 KB · Affichages: 76
  • Exemple2.xlsm
    33.4 KB · Affichages: 72

Nono89

XLDnaute Nouveau
Re : Insertion d'une ligne sous condition

Bonjour Grand Chaman,

Merci, avec ces explications ça m'a permis de comprendre le fonctionnement du code, et du coup d'y apporter quelques modifications qui fonctionnent!! sur les lignes de total général.

Et je prend le temps d'affiner les selects.

Même si j'ai eu la surpise de constater que la macro prenait près de 1/4d'h (et vii j'ai environ 100 000 lignes), ça n'en reste pas moins un gains de temps prodigieux par rapport au traitement manuel de l'ensemble des informations.


Encore merci de ton temps et de tes explications.



A+
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Insertion d'une ligne sous condition

Bonjour Nono89,

Une autre méthode qui pourrait être plus rapide :

Dans Excel 2007, regarde sous Données | Plan | Sous-Total
Ceci te générera les sous-totaux pour chaque client.
Tu peux combiner avec une macro pour tes formules SI et tes ratios à la fin.

J'ai fait un petit test et ça a pris 2 min pour calculer les sous-totaux pour un fichier de 45000 lignes (sans les SI et les ratio).

A essayer.
A+
 

Nono89

XLDnaute Nouveau
Insertion d'une ligne sous condition

Très bonne idée le sous.total (je m'aperçois que j'avais posé mon problème à l'envers au début xD)

Du coup j'ai une macro qui prend à peine plus de 3 min, de plus ça m'a permis de me familiariser avec les fameuses références pour insérer les formules "SI".

Et ça marche!!


Voici le code final :

' Sous total
Range("A1").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(10, 11), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

' Fonction si fam (colonne N et O)
Range("N2:N" & Range("B65000").End(xlUp).Offset(-1, 0).Row).FormulaR1C1 = "=if(RC3="""",if(RC10>0,1,""""),"""")"
Range("O2:O" & Range("B65000").End(xlUp).Offset(-1, 0).Row).FormulaR1C1 = "=if(RC3="""",if(RC11>0,1,""""),"""")"

Dim rg As Range
Dim rgdep As Range

'Trouvons la dernière cellule dans la colonne B et plaçons nous 1 cellule dessous
Set rg = Range("B65000").End(xlUp).Offset(0, 0)

rg.Offset(0, 8).Resize(1, 2).NumberFormat = "#,##0"
rg.Offset(2, 8) = "nb couples"
rg.Offset(2, 10).FormulaR1C1 = "=SUM(R2C:R[-3]C)"
rg.Offset(2, 11).FormulaR1C1 = "=SUM(R2C:R[-3]C)"
rg.Offset(2, 12).FormulaR1C1 = "=SUM(R2C:R[-3]C)"
rg.Offset(2, 13).FormulaR1C1 = "=SUM(R2C:R[-3]C)"

rg.Offset(4, 8) = "Moyenne fam / client"
rg.Offset(4, 10).FormulaR1C1 = "=R[-2]C/R[-2]C[2]"
rg.Offset(4, 11).FormulaR1C1 = "=R[-2]C/R[-2]C[2]"
rg.Offset(4, 10).Resize(1, 2).Style = "Comma"

'Bordure
Set rg = rg.Offset(0, -1).Resize(5, 15)
With rg
.Font.Bold = True
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous

.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With

Application.ScreenUpdating = True




Merci pour ton aide et tes conseil avisé grand chaman!!

Ps: ce code peut paraître sans début ou mal terminé, en réalité il s'insère dans une macro plus globale qui va chercher les données dans une base et crèe un onglet par commercial à fin d'y insérer les données lui faisant référence.
Et par une boucle le code ci-dessus se répète dans chaque onglet créé.




A+

nono
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 425
Membres
103 206
dernier inscrit
diambote