Soustraire après insertion ligne

M

Maxime7

XLDnaute Nouveau
Bonjour à vous tous,

Je suis nouveau dans ce forum, je ne connais pas forcément la manière pour décrire le problème mais j'ai pas mal feuilleté les forums et espère pouvoir trouver de l'aide et vous expliquer clairement mon problème.

J'ai les notions en VBA et j'essaye à chaque fois de résoudre mes problèmes tout seul mais la je n'arrive pas du tout et je ne sais pas comment faire.

J'ai sur mon fichier une base de données.
Sur cette même base de données, j'aimerai sur les colonnes B et C pour chacune des lignes, SI B x C > N alors il me copie la ligne et me l'insert juste en dessous de la ligne correspondante.
Pour le moment j'y suis arrivé à le faire en VBA.
La seule chose qui me manque c'est faire en sorte qu'il me soustrait le chiffre de la colonne B pour que lorsque je fais BxC il ne soit pas supérieur à N et faire attention que le chiffre de départ en colonne B soit répartie équitablement sur les lignes copiée et insérées. Si au départ j'ai un chiffre x que je retrouve la quantité exacte sur les lignes insérées et sur la ligne de départ.

Par exemple :
Une ligne quelconque qui correspond à B x C > N :
Cellule en B = 3
Cellule en C = 500
Cellule N = 1000

Si 3 x 500 > 1000
alors il va me créer une ligne avec
Cellule B = 2
Cellule C = 500
Cellule N = 1000

et une autre ligne avec
Cellule B = 1
Cellule C = 500
Cellule N = 1000

Il n'y a que la valeur de la cellule B qui est modifiée et répartie équitablement sur les autres lignes. Et la ligne originale en question ne soit plus existante ou bien si vous ne la supprimer pas, il faut juste que je ne me retrouve pas avec 3 lignes au lieu de 2 comme sur l'exemple. Au total j'ai 2 lignes identiques mais avec la cellules B répartie équitablement sur l'ensemble. Je précise que ce sont que des chiffres entiers.

J'illustre avec un autre exemple :
Une ligne quelconque qui correspond à B x C > N :
Cellule en B = 10
Cellule en C = 500
Cellule en N = 700

Si 10 x 500 > 700
alors il va me créer une ligne avec
Cellule B = 1
Cellule C = 500
Cellule N = 700

puis une autre ligne
Cellule B = 1
Cellule C = 500
Cellule N = 700

En tout il va me créer 10 lignes car à chaque fois il ne faut pas que B x C soit supérieure à N. Il me créer autant de ligne que nécessaire de telle sorte que B x C ne soit pas supérieur à N.

J'espère avoir bien été clair sur mes explications.
Je vous mets en copie mon fichier afin que vous puissiez voir le résultat attendu. Un onglet Base sur lequel le résultat devrait y être effectué et un autre onglet Résultat avec ce que j'attends que la macro fasse.

Je vous remercie par avance de votre aide à tous !!!

Maxime7
 

Pièces jointes

  • Insérer une ligne si condition vraie.xlsm
    28.7 KB · Affichages: 10
Trier par date Trier par votes
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @Maxime7 :)
Bienvenue sur XLD :),

Une version à ma sauce. Tout se passe avec des tableaux en mémoire. C'est donc très rapide.
Pour ne rien casser, j'ai mis le résultat sur le feuille "Result".
Le code est commenté.

Edit : j'ai mal lu votre énoncé. Je divise les lignes avec une colonne B au maximum. Ce qui fait que je ne respecte pas votre énoncé : je ne répartie équitablement dans certains cas:
exemple en colonne B : 50, en colonne C : 15,00 et en colonne G : 700,00
Ma macro donnera deux lignes : l'une avec en colonne B -> 46 et l'autre ligne avec en colonne B -> 4 :mad:. En fait, j'avais raté le mot équitablement o_O. On verra ça demain soir au plus tôt.

le code en module1:
VB: 
Option Explicit

Sub InsertLigne()
Dim derlig&, t, i&, j&, k&, n&, max, nligne&


Application.ScreenUpdating = False
With Sheets("Base")
   If .FilterMode Then .ShowAllData                            ' si filtrage, on affiche tout (sinon End(xlUp) sera faux)
   derlig = .Range("A" & Rows.Count).End(xlUp).Row             ' dernière ligne de la base
   t = .Range("a1").Resize(derlig, 8)                          ' lecture de toute la base dans le tableau t

                                                               ' calcul du nombre n de lignes du tableau résultat
   n = 1                                                       ' n = 1  on réserve une ligne pour les en-têtes
   For i = 2 To UBound(t)                                      ' boucle sur la base
   
      If t(i, 2) * t(i, 3) > t(i, 7) And t(i, 2) > 1 Then      ' on divise une ligne i si la colonne B est  supérieure à 1
                                                               ' et si la colonne B * la colonne C est supérieur à la colonne G
         max = Application.RoundDown(t(i, 7) / t(i, 3), 0)     ' max est le quantité max pour que le produit
                                                               ' colonne B * la colonne C est inférieur ou égal à la colonne G
         n = n + Application.RoundUp(t(i, 2) / max, 0)         ' Application.RoundUp(t(i, 2) / max, 0) est le nombre de lignes
                                                               ' après division de la ligne i
      Else
         n = n + 1                                             ' la condition n'est pas vérifiée, ça fait juste une ligne en plus
      End If
   Next i

   ReDim v(1 To n, 1 To 8)                                     ' dimmensionnement du tableau résultat v
   For j = 1 To UBound(t, 2): v(1, j) = t(1, j): Next          ' om met dans v la ligne d'en-têtes

   n = 1                                                       ' n = 1  on a déjà mis la ligne d'en-têtes
   For i = 2 To UBound(t)                                      ' boucle sur la base
      If t(i, 2) * t(i, 3) > t(i, 7) And t(i, 2) > 1 Then      ' la condition est vérifiée
         max = Application.RoundDown(t(i, 7) / t(i, 3), 0)     ' idem ci-dessus
         nligne = Application.RoundUp(t(i, 2) / max, 0)        ' idem ci-dessus
         For k = 1 To nligne - 1                               ' sur le nombre final de ligne moins une
                                                               ' en effet ces lignes auront la Max en colonne B
                                                               ' la dernière ligne divisée aura le nombre total à diviser
                                                               ' moins la somme des max jusqu'à nligne-1
         
            n = n + 1                                          ' on écrit sur la ligne suivante de v
            For j = 1 To 8: v(n, j) = t(i, j): Next            ' on y met tous les éléments de la ligne i
            v(n, 2) = max                                      ' on met en colonne N la valeur max
         Next k
     
                                                               ' on traite la dernière ligne divisée
         n = n + 1                                             ' on incrémente le numéro de ligne de v
         For j = 1 To 8: v(n, j) = t(i, j): Next               ' on y met tous les éléments de la ligne i
         v(n, 2) = t(i, 2) - (nligne - 1) * max                ' on met en colonne B le restant du njombre initiale en colonne B
                                                               ' - la somme des max des lignes divisées jusqu'à l'avant-dernière
      Else
         n = n + 1                                             ' la ligne i n'est pas à diviser - on invrémente la ligne de V
         For j = 1 To 8: v(n, j) = t(i, j): Next               ' on y met tous les éléments de la ligne i
      End If
   Next i
End With

With Sheets("Result")
   .Range("a1").CurrentRegion.Clear                            ' effacement des précédents résultats
   .Range("a1").Resize(UBound(v), UBound(v, 2)) = v            ' transfert du tableau résultat v sur la feuille "Result"
   .Activate
End With
End Sub
 

Pièces jointes

  • Maxime7- Insérer lignes si condition- v1.xlsm
    36.5 KB · Affichages: 6
Dernière édition:
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

La v2 qui répartit équitablement.

VB: 
Option Explicit

Sub InsertLigne()
Dim derlig&, t, i&, j&, k&, n&, max, nligne&, combien&


Application.ScreenUpdating = False
With Sheets("Base")
   If .FilterMode Then .ShowAllData                            ' si filtrage, on affiche tout (sinon End(xlUp) sera faux)
   derlig = .Range("A" & Rows.Count).End(xlUp).Row             ' dernière ligne de la base
   t = .Range("a1").Resize(derlig, 8)                          ' lecture de toute la base dans le tableau t
 
                                                               ' calcul du nombre n de lignes du tableau résultat
   n = 1                                                       ' n = 1  on réserve une ligne pour les en-têtes
   For i = 2 To UBound(t)                                      ' boucle sur la base
     
      If t(i, 2) * t(i, 3) > t(i, 7) And t(i, 2) > 1 Then      ' on divise une ligne i si la colonne B est  supérieure à 1
                                                               ' et si la colonne B * la colonne C est supérieur à la colonne G
         max = Application.RoundDown(t(i, 7) / t(i, 3), 0)     ' max est le quantité max pour que le produit
                                                               ' colonne B * la colonne C est inférieur ou égal à la colonne G
         n = n + Application.RoundUp(t(i, 2) / max, 0)         ' Application.RoundUp(t(i, 2) / max, 0) est le nombre de lignes
                                                               ' après division de la ligne i
      Else
         n = n + 1                                             ' la condition n'est pas vérifiée, ça fait juste une ligne en plus
      End If
   Next i
 
   ReDim v(1 To n, 1 To 8)                                     ' dimmensionnement du tableau résultat v
   For j = 1 To UBound(t, 2): v(1, j) = t(1, j): Next          ' om met dans v la ligne d'en-têtes
 
   n = 1                                                       ' n = 1  on a déjà mis la ligne d'en-têtes
   For i = 2 To UBound(t)                                      ' boucle sur la base
      If t(i, 2) * t(i, 3) > t(i, 7) And t(i, 2) > 1 Then      ' la condition est vérifiée
         max = Application.RoundDown(t(i, 7) / t(i, 3), 0)     ' idem ci-dessus
         nligne = Application.RoundUp(t(i, 2) / max, 0)        ' idem ci-dessus
         combien = Application.RoundDown(t(i, 2) / nligne, 0)  ' la quantité pour chaque ligne
         For k = 1 To nligne                                   ' boucle sur le nombre final de ligne
            n = n + 1                                          ' on incrémente le numéro de ligne de v
            For j = 1 To 8: v(n, j) = t(i, j): Next            ' on y met tous les éléments de la ligne i
            v(n, 2) = combien                                  ' La quantité est 'combien'
         Next k
         For k = 1 To (t(i, 2) - nligne * combien)             ' On répartit ce qui n"a pas été distribué -> (t(i, 2) - nligne * combien)
            v(n - nligne + k, 2) = v(n - nligne + k, 2) + 1    ' et on rajoute à autant de ligne qu'il faut +1  jusqu'à
         Next k                                                ' épuisement de ce qu'on avait pas distribué
      Else
         n = n + 1                                             ' la ligne i n'est pas à diviser - on incrémente la ligne de V
         For j = 1 To 8: v(n, j) = t(i, j): Next               ' on y met tous les éléments de la ligne i
      End If
   Next i
End With
     
With Sheets("Result")
   .Range("a1").CurrentRegion.Clear                            ' effacement des précédents résultats
   .Range("a1").Resize(UBound(v), UBound(v, 2)) = v            ' transfert du tableau résultat v sur la feuille "Result"
   .Activate
End With
End Sub
 

Pièces jointes

  • Maxime7- Insérer lignes si condition- v2.xlsm
    37.9 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
M

Maxime7

XLDnaute Nouveau
Salut mapomme

C'est extraordinaire !!
J'aurai jamais réussi à faire ça. Je te suis carrément reconnaissant pour ton aide !!

Je te remercie beaucoup pour tes explications ^^ c'est super top.

Quand je le mets sur l'onglet base
VB: 
With Sheets("Base")
   .Range("a1").CurrentRegion.Clear                            ' effacement des précédents résultats
   .Range("a1").Resize(UBound(v), UBound(v, 2)) = v            ' transfert du tableau résultat v sur la feuille "Result"
   .Activate
End With
, cela me rajoute la ligne de l'en-tête, est-ce que cela est possible que ta macro ne me rajoute pas l'en-tête et que ce dernière ne se concentre que sur la base de données sans l'en-tête ?

J'ai essayé de changer un peu pour que lorsque je réalise ta macro, mon en-tête ne se modifie pas et ne se rajoute pas parmi les résultats mais en vain.

En effet, sur les colonne D à M il y a des formules et avec une formule de tirage de formule je garde les formules de D2 à M2 pour les tirer vers le bas. Avec ton super travail ^^, le résultat me supprime aussi les formules que je souhaite garder.

C'est un super travail, tu es génial !!

Si tu as le temps de rectifier légèrement ta macro, ça serait super sinon je vais trouver une autre solution. Mais cela me demandera d'ajouter une macro qui me transpose les résultats vers une autre feuille et ajouter une macro.

Merci encore pour ton aide ^^

Maxime7
 
Vote positif 0 Vote négatif
M

Maxime7

XLDnaute Nouveau
Re mapomme,

J'ai réussi à éviter que cela ne colle l'entête en modifiant ceci :

J'ai remplacer les 1 par 2
Code: 
 ReDim v(2 To n, 1 To 8)                                     ' dimmensionnement du tableau résultat v
   For j = 1 To UBound(t, 2): v(2, j) = t(2, j): Next          ' om met dans v la ligne d'en-têtes

et j'ai modifié ceci :
Code: 
With Sheets("Result")
   .Range("a1").CurrentRegion.Clear                            ' effacement des précédents résultats
   .Range("a1").Resize(UBound(v), UBound(v, 2)) = v            ' transfert du tableau résultat v sur la feuille "Result"
   .Activate
End With

par :
Code: 
With Sheets("Base")

    .Range("a2:M1000").ClearContents                            ' effacement des précédents résultats

    .Range("a2").Resize(UBound(v), UBound(v, 2)) = v            ' transfert du tableau résultat v sur la feuille "Result"

    .Activate

End With

Ceci règle mon problème de l'entête mais ne me garde pas les formules des colonnes D à M vu que la macro remplace les cellules par un collage de valeur.

Je ne sais pas comment faire -_-'

Merci pour ton aide encore une fois !!

Maxime7
 

Pièces jointes

  • Maxime7- Insérer lignes si condition- v2.xlsm
    34.8 KB · Affichages: 4
Vote positif 0 Vote négatif
M

Maxime7

XLDnaute Nouveau
Re encore mapomme

Finalement dans mon fichier original j'ai ajouté un onglet en plus pour basculer comme tu as fait avec ta macro et avec ce nouvel onglet j'ai fait un copier coller des valeurs dont j'avais besoin vers l'onglet en question.

J'ai utilisé le nouvel onglet pour faire l'intermédiaire.

Je ne veux pas te déranger plus, c'est déjà énorme ce que tu as fait, je te remercie énormément !!! Tu as respecté mon enoncé et ce que je te demande en plus n'étais pas marqué donc je trouve cela abusif de te demander autre chose.

Mille merci mon ami ^^

A+

Maxime7
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Maxime7,

Il me semble que le plus simple serait de faire en valeur (comme c'est fait) puis une fois le résultat collé sur la base réintroduire les formules dans les colonnes qui avaient une formule.

Mais:
  • je n'ai pas de fichier reflétant votre fichier réel
  • je ne connais pas les colonnes avec des formules
  • je ne connais pas ces formules
Je ne peux donc pas proposer quelque chose...
 
Vote positif 0 Vote négatif
M

Maxime7

XLDnaute Nouveau
mapomme à dit:
Bonjour @Maxime7,

Il me semble que le plus simple serait de faire en valeur (comme c'est fait) puis une fois le résultat collé sur la base réintroduire les formules dans les colonnes qui avaient une formule.

Mais:
  • je n'ai pas de fichier reflétant votre fichier réel
  • je ne connais pas les colonnes avec des formules
  • je ne connais pas ces formules
Je ne peux donc pas proposer quelque chose...
Cliquez pour agrandir...

Bonjour @mapomme

  • je n'ai pas de fichier reflétant votre fichier réel ==> En PJ avec des modifications sans formules car je ne peux pas, cela prendra trop de temps pour modifier les valeurs.
  • je ne connais pas les colonnes avec des formules ==> les colonnes A à E, sont sans formules et les autres jusqu'à la fin possèdent des formules
En faite, je ne joue qu'avec les colonne AU, BB et BE. Sur l'exemple du premier fichier AU correspond à la colonne B, BB à la colonne C et BE à la colonne G


  • je ne connais pas ces formules
Colonne AU = SIERREUR(ARRONDI.SUP(AR2;0);"")
Colonne BB = AZ+K2
Colonne BE = RechercheV de la colonne A pour avoir le max de la valeur provenant d'un autre onglet

Quand je tente de modifier les données qui sont de la colonne A à E, il me réactualise les données. Quand je lance ta macro il y a ce problème.

Erreur exécution '11' :
Division par zéro


Je n'arrive pas à supprimer cette erreur.
Serait-il possible que tu m'aides encore une fois ?

Merci par avance @mapomme

Maxime7
 

Pièces jointes

  • Classeur4.xlsm
    39.3 KB · Affichages: 7
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom
Réponses
10
Affichages
203
chaelie2015
chaelie2015
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la création de feuilles en fonction des données de la cellule U13 et une feuille type
Réponses
7
Affichages
241
chaelie2015
chaelie2015
S
  • Question
XL 2021 ecrire macro vba
Réponses
2
Affichages
165
Bernard_XLD
Bernard_XLD
T
  • Question
XL 2016 SI INDEX EQUIV Doublons...
Réponses
8
Affichages
155
Titiem
T
T
  • Question
XL 2016 Recherche a deux conditions dans plusieurs onglets
Réponses
12
Affichages
401
thivame
T
B
  • Question
XL 2016 Macro pour identifier un texte dans un tableau et appliquer une modification sur une cellule sur la même ligne
Réponses
5
Affichages
242
ChTi160
ChTi160
J
  • Question
XL 2016 Optimisation SOMMEPROD (résolu)
Réponses
11
Affichages
405
tbft
tbft
N
  • Résolu(e)
XL 2016 créer un tableau qui contient tous les distances entre les stations de bus
Réponses
4
Affichages
267
nasri badreddine
N
B
  • Résolu(e)
Microsoft 365 Fonction cellule en décalage
Réponses
9
Affichages
262
BOILEAU
B
T
  • Question
Microsoft 365 Créer plusieurs onglets
Réponses
5
Affichages
227
themyse1
T

Membres actuellement en ligne

17 membres et 195 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 097
Messages
2 085 256
Membres
102 839
dernier inscrit
Tougtoug