Soustraire après insertion ligne

Maxime7 · 27 Mai 2020

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

mapomme · 27 Mai 2020

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 . En fait, j'avais raté le mot équitablement . 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

mapomme · 28 Mai 2020

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

Maxime7 · 28 Mai 2020

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

Maxime7 · 28 Mai 2020

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

Maxime7 · 28 Mai 2020

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

mapomme · 28 Mai 2020

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...

Maxime7 · 22 Juin 2020

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...

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

Soustraire après insertion ligne

Maxime7

XLDnaute Nouveau

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Maxime7

XLDnaute Nouveau

Maxime7

XLDnaute Nouveau

Pièces jointes

Maxime7

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Maxime7

XLDnaute Nouveau

Pièces jointes

Discussions similaires