Microsoft 365 [VBA] Macro pour automatiser une sortie

asso78Lim

XLDnaute Nouveau
Bonjour à toutes et à tous,
Tout d'abord je tenais à remercier les intervenants du forum pour leurs implications et les solutions mise à disposition de tous !

J'ai un problème que je n'arrive pas à résoudre malgré plusieurs tentatives et moultes recherches, mes compétences en VBA sont très limités mais la plupart du temps j'arrive à m'en sortir à l'aide du forum (encore merci!).

J'ai un tableau qui recense toutes les dépenses liées à mon petit commerce et qui s'actualise à chaque nouvel achat.
Pour chaque produit j'ai un budget à ne pas dépasser lors de mes commandes que je modifie en fonction de mes besoins chaque mois.
Les achats réalisés sont inscris manuellement sur un autre tableau à l'aide d'un userform.
Travaillant avec des personnes d'un certain âge qui n'arrive pas toujours à utiliser excel, j'aimerais automatiser cette action pour éviter des erreurs et limiter le stress que ça peut représenter par "peur de mal faire".


Voici mon problème,
Dans le fichier excel joint il y'a 3 feuilles : "Achat", "Budget", "Résumé"

J'aimerais qu'en cliquant sur un bouton :

-Les références présentes dans la feuille budget se mette automatiquement à jour (en les soustrayant) en fonction des références présentes sur la feuille "Achat"

-Dans la feuille "Résumé", j'essaye (mais en vain) de retranscrire les achats réalisés à la suite avec les informations de la référence (qui se trouve dans la feuille "Budget"), le montant de la commande et le budget final après la commande.
(J'ai fais un exemple sur le fichier joint, c'est plus compréhensible qu'une explication hasardeuse)

-Si lors d'un clic l'un des budgets devient négatif prévenir l'utilisateur.

Pour le premier point j'ai réussi à bidouiller quelque chose mais avec un code incompréhensible, j'ai l'espoir que quelqu'un pourra me proposer un code plus simple.
Pour le deuxième point j'ai essayé de nombreux code mais je ne comprend pas toutes les subtilités et il est pour moi impossible de réaliser ça tout seul.

Merci à vous d'avoir pris le temps de me lire (c'était long désolé) et je remercie d'avance les intervenants qui prendront le temps de me répondre si solution il existe.
En vous souhaitant une excellente journée,

Asso
 

Pièces jointes

  • modèle (1) (2) (2).xlsm
    31.9 KB · Affichages: 5
Dernière édition:
Solution
Bonjour Asso, Staple1600,

nouveau fichier, avec la simplification proposée par Staple. :)

VB:
Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub 'sortir de la sub si référence non trouvée
    dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5): ect = .Cells(cel.Row, 6)
  End With
  With Worksheets("Résumé").Cells(j, 2)
    .Value = Date
    .Offset(, 1) = StrConv(Format(Date, "dddd"), 3) 'jour de la semaine
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf...

asso78Lim

XLDnaute Nouveau
Vu que j'ai pas été très précis dans mon premier message je vais essayer d'être plus explicite 😁

Sur la feuille achat originel, se trouve un tableau qui s'actualise tout seul à chaque ouverture du classeur.
Le but serait qu'a chaque fois qu'on clique sur un bouton, le budget alloué dans la feuille "Budget" se mette automatiquement à jour en fonction des références présentes sur la feuille "Achat".

Pour la feuille "résumé", j'aimerais que les éléments présent sur la feuille "Achat" soit transposé dans la feuille "Résumé"
-avec la date du jour en colonne A.
-le jour en colonne B
-la mention "Achat" en colonne C
-la mention "X" en colonne D
-les références de la feuille "Achat" en colonne E
-la désignation associée à ces références(qu'on peut trouver sur la feuille "budget") en colonne F
-le montant de la commande de la référence qu'on va retrouver dans la feuille "Achat"
-le budget restant pour la référence associé en colonne H.

Je sais pas si ça paraît plus clair comme ça en fin de compte... o_Oo_O
 

soan

XLDnaute Barbatruc
Inactif
Bonjour Asso, le fil,

ton fichier en retour ; je te laisse tester les 2 boutons. :)

code VBA de la feuille "Achat" :

VB:
Option Explicit

Dim T, n&

Private Sub ReadAchats()
  n = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[C3].Resize(n, 2)
  End With
End Sub

Private Sub Bouton1_Click()
  Call ReadAchats: If n = 0 Then Exit Sub
  Dim cel As Range, vx&, i&: Application.ScreenUpdating = 0
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5)
          vx = .Value - T(i, 2): If vx > 0 Then .Value = vx
        End With
      End If
    Next i
  End With
End Sub

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If Not cel Is Nothing Then dsg = .Cells(cel.Row, 3)
  End With
  With Worksheets("Résumé").Cells(j, 1)
    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"
    .Offset(, 3) = "Frs X"
    .Offset(, 4) = réf
    .Offset(, 5) = dsg
    .Offset(, 6) = T(i, 2) 'Achat / Montant commande
  End With
End Sub

Private Sub Bouton2_Click()
  Call ReadAchats: If n = 0 Then Exit Sub
  Dim i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 2, 1: j = 2
    Else
      .ListRows.Add: j = .ListRows.Count + 1: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
     For i = 2 To n
       .ListRows.Add: j = j + 1: WriteLig j, i
     Next i
  End With
  MsgBox "Transfert effectué dans la base de données"
End Sub

si besoin, tu peux demander une adaptation.
merci de me donner ton avis. ;)

soan
 

Pièces jointes

  • Modèle (1) (2) (2).xlsm
    35.1 KB · Affichages: 1

asso78Lim

XLDnaute Nouveau
C'est vraiment impressionnant.. :eek:

J'ai quelques questions,

-Penses-tu que ce code fonctionne avec un tableau créée à l'aide de Powerquery ?
ça fonctionne je viens de tester sur mon fichier d'origine à l'instant

-Le bouton 1 ne fonctionne pas si lors de la soustraction un des budget doit devenir nul, est-il possible d'effectuer la soustraction même si on passe dans le négatif ?

-Est-il possible d'indiquer le budget restant dans la feuille "Résumé" en colonne H ?

-Est-il possible de fusionner le code pour en faire un seul bouton ? (J'ai fais 2 boutons pour pas me perdre dans mes variables 😅😅)

(dernière question facultative 😁, pourrais-tu me mettre des commentaires dans le code j'aimerais beaucoup comprendre le fonctionnement )

En tout cas, merci beaucoup pour le temps que tu y a consacré et le travail que tu as fournis !!!!!!!!!!!!!!!!!!!!
Quand je repense au code que j'ai essayé de produire je deviens rouge de honte devant le tiens 🤒🤒🤒🤒

Encore merci !
 
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Asso,

Quand je repense au code que j'ai essayé de produire je deviens rouge de honte devant le tien 🤒🤒🤒🤒

tu n'as pas à rougir de ton code VBA ; moi aussi, au début, je faisais des codes dans le genre du tien ; on a tous commencé par le b a ba. ;) (même à mon niveau, il y a d'autres membres sur le forum qui sont meilleurs que moi)



Le bouton 1 ne fonctionne pas si lors de la soustraction un des budget doit devenir nul

c'est tout à fait normal : j'avais pensé qu'un budget ne pouvait être que supérieur à 0 ; donc un achat n'était pas déduit si ça entraînait un budget nul ou négatif (c'était fait exprès, je voulais que tu t'en rendes compte par toi-même, et je voulais savoir ce que tu allais en penser).
est-il possible d'effectuer la soustraction même si on passe dans le négatif ?

oui, c'est fait dans le nouveau code VBA : un budget peut devenir nul ou négatif ; j'ai simplement enlevé le test correspondant, et j'ai aussi supprimé la variable vx qui n'était utilisée que pour ça.


Est-il possible d'indiquer le budget restant dans la feuille "Résumé" en colonne H ?

oui, c'est fait dans le nouveau code VBA ; ça fonctionne bien pour le fichier exemple, mais comme il y a trop peu de données, je ne sais pas si ça fonctionnera aussi bien dans ton fichier réel (qui comporte forcément plus de données) ; il y aura peut-être une adaptation à faire ? si oui, il faudra que tu fournisses un autre fichier exemple, avec bien plus de données, pour que ce fichier exemple soit plus représentatif du cas réel (avec de la chance, ça fonctionnera bien pour ton vrai fichier, et il n'y aura pas besoin de modifier le code VBA).​



Est-il possible de fusionner le code pour en faire un seul bouton ? (J'ai fais 2 boutons pour pas me perdre dans mes variables 😅😅)

oui, c'est fait dans le nouveau fichier : il y a un seul bouton ; ça a l'air de pas grand chose, mais ça a quand même entraîné beaucoup de modifs dans le code VBA.​



pourrais-tu me mettre des commentaires dans le code j'aimerais beaucoup comprendre le fonctionnement

oui, c'est tout à fait possible ; mais ce sera pour bien plus tard, dans un autre post ; une bonne explication de code est très longue à faire, donc ce ne sera probablement pas avant demain ; de plus, je veux d'abord être sûr que la version actuelle du fichier te convient avant de commencer à faire les commentaires.​



Mode d'emploi

* à l'ouverture du fichier, tu es sur la feuille "Résumé" ; note que Tableau3 est vide (à part les en-têtes).
* va sur la feuille "Budget" ; note que pour la réf 10 : en E11, Budget alloué : 70 (c'est le budget initial).

* va sur la feuille "Achat" ; il y a maintenant un seul bouton ; clique dessus. :)

* comme tu peux le voir, au lieu d'afficher le message "Transfert effectué dans la base de données", ça va automatiquement sur la 2ème feuille "Budget" pour montrer Tableau2 ; tu peux voir qu'en E11 : budget alloué initial de 70 - Achat de 20 = 50 (c'était l'effet du 1er bouton).

* va sur la feuille "Résumé" ; a) 70 - 20 = 50 ; puis b) 50 - 15 = 35 ; il me semble bien que c'est correct, n'est-ce pas ? sinon, il faudra faire plus tard une adaptation (tu devras mieux préciser le détail des calculs pour obtenir le "Budget final").

* retourne sur la feuille "Achat" ; sans rien changer, clique une 2ème fois sur le bouton ; ça va de nouveau sur la feuille "Budget" ; pour la réf 10, en E11 : 50 - 20 = 30. (effet de l'ex-1er bouton)

* va sur la feuille "Résumé" ; a) 50 - 20 = 30 ; puis b) 30 - 15 = 15 ; note bien que les 2 nouvelles lignes ont été ajoutées en dessous des 2 lignes précédentes.


Code VBA

VB:
Option Explicit

Dim T, bdg&

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, mnc&: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If Not cel Is Nothing Then dsg = .Cells(cel.Row, 3)
  End With
  mnc = T(i, 2): bdg = bdg - mnc 'montant commande (idem que achat) ; budget final = budget alloué - achat
  With Worksheets("Résumé").Cells(j, 1)
    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"
    .Offset(, 3) = "Frs X"
    .Offset(, 4) = réf
    .Offset(, 5) = dsg
    .Offset(, 6) = mnc
    .Offset(, 7) = bdg
  End With
End Sub

Private Sub Bouton_Click()
  Dim cel As Range, n&, i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[C3].Resize(n, 2)
  End With
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5)
          bdg = .Value: .Value = bdg - T(i, 2)
        End With
      End If
    Next i
  End With
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 2, 1: j = 2
    Else
      .ListRows.Add: j = .ListRows.Count + 1: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
     For i = 2 To n
       .ListRows.Add: j = j + 1: WriteLig j, i
     Next i
  End With
  Worksheets("Budget").Select
End Sub

soan
 

Pièces jointes

  • Modèle (1) (2) (2).xlsm
    31.9 KB · Affichages: 1
Dernière édition:

asso78Lim

XLDnaute Nouveau
Le code marche du tonnerre youhou !! 🥳🥳🥳
Il y'a juste un problème avec la partie budget final, le budget final de la première référence s'affiche correctement mais quand il y'a en plusieurs au lieu de soustraire simplement les achats de cette référence ça le fait à la suite.

Exemple : référence 1 budget = 10 et achat 5
référence 2 budget = 10 et achat 5

Dans la feuille résumé, pour le budget final il y'aura bien écrit budget final = 5 pour la référence1 mais pour la référence 2 il va faire 10 - 5 -5 donc on sera à 0

Mis à part ça c'est parfait tout fonctionne exactement comme je l'imaginais!!
merci beaucoup 😀

EDIT : Rajouter un message à l'utilisateur quand le budget passe au négatif si c'est pas possible ce n'est pas grave je suis déjà ravi !!!
 

soan

XLDnaute Barbatruc
Inactif
si j'ai bien compris : a) pour la 1ère référence, c'est ok ; b) il faudrait faire ce que ça fait pour une référence (la 1ère ou autre), mais sans qu'il y aie mélange entre les différentes références.

envoie un autre fichier exemple avec quelques références (environ 5, minimum : 3) ; j'essayerai de trouver une solution ; c'est sans garantie, car pour le budget final, c'est pas évident !​

soan
 

asso78Lim

XLDnaute Nouveau
Pas de soucis tu as déjà fourni un sacré travail!
En cliquant sur le bouton, normalement tous les budget finaux sur la feuille résumé devrait afficher 0, la ca va le faire en cascade et tu vas avoir : 0 / -5 / -10 / -15 / -20
 

Pièces jointes

  • Modèle (1) (2) (2) (5).xlsm
    29.3 KB · Affichages: 2

soan

XLDnaute Barbatruc
Inactif
Bonjour Asso,

ton 2ème fichier en retour. :)

Mode d'emploi

* à l'ouverture du fichier, tu es sur la feuille "Résumé" ; note que Tableau3 est vide (à part les en-têtes).

* va sur la feuille "Budget" ; c'est inchangé ➯ tous les budgets alloués sont de 5 (ce sont les budgets initiaux).

* va sur la feuille "Achat" ; là, j'ai mis 8 au lieu de 5 en D4 et D6 pour qu'il y aie ensuite 2 exemples de budgets qui deviennent négatifs ; ainsi, tu pourras avoir un message d'avertissement ; clique sur le bouton.

* ça va automatiquement sur la 2ème feuille "Budget", et comme il y a au moins un budget négatif, tu as un message d'avertissement. ;)

* clique sur le bouton OK de la boîte de dialogue "Budget(s) négatif(s)", et va sur la feuille "Résumé" ; cette fois, je crois bien que toutes les données sont correctes, y compris celles de la colonne H. 😊

(reste à tester sur ton vrai fichier ; si tu me dis que tout est ok, je ferai alors un commentaire du code VBA ; mais je rappelle que ça sera très long à faire, donc il faudra patienter longtemps)

Code VBA

VB:
Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If Not cel Is Nothing Then
      dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5)
    End If
  End With
  With Worksheets("Résumé").Cells(j, 1)
    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", _
      "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf      'Référence
    .Offset(, 5) = dsg      'Désignation
    .Offset(, 6) = T(i, 2)  'Montant commande (idem que Achat)
    .Offset(, 7) = bdg      'Budget final
  End With
End Sub

Private Sub Bouton_Click()
  Dim cel As Range, bdg&, chn$, n&, i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[C3].Resize(n, 2)
  End With
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5)
          bdg = .Value - T(i, 2): .Value = bdg
          If bdg < 0 Then _
            chn = chn & "* en ligne " & i + 1 & " : " & bdg & vbLf
        End With
      End If
    Next i
  End With
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 2, 1: j = 2
    Else
      .ListRows.Add: j = .ListRows.Count + 1: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
     For i = 2 To n
       .ListRows.Add: j = j + 1: WriteLig j, i
     Next i
  End With
  Worksheets("Budget").Select: Application.ScreenUpdating = -1
  If chn <> "" Then MsgBox chn, , "Budget(s) négatif(s)"
End Sub

soan
 

Pièces jointes

  • Modèle (1) (2) (2) (5).xlsm
    31.2 KB · Affichages: 2
Dernière édition:

asso78Lim

XLDnaute Nouveau
Bonjour @soan,

encore une fois je te remercie pour le temps que tu accordes à ma problématique!

J'ai effectué tous les tests et tout fonctionne comme prévu!
En essayant de transposer ce code dans le fichier original j'ai eu un seul bémol c'est dans la feuille "résumé".
Sachant que dans le fichier de base tout est décalé d'une colonne et qu'il y'a une colonne en plus je n'ai pas réussi à adapter ton code pour que les informations se positionnent au bon endroit.

Les informations de la colonne en plus se trouve dans la feuille "Budget".
Est-il possible de reporter les informations de la colonne en fonction de la référence sur la feuille "Résumé" ?

Sinon mise à part ça tout fonctionne parfaitement, je te joins à nouveau le même fichier mais cette fois-ci qui respecte scrupuleusement la mise en page du fichier original.
(Tu verras que sur la feuille "Achat" la première référence ne commence plus en C3 mais en E5)

En tout cas merci pour ton aide, c'était vraiment ce que je cherchais à faire et tu as réalisé ça avec brio !!!!
Si un jour tu passes dans le sud préviens moi je t'offre le café 😁😁😁😁

EDIT : C'est un fichier avec quelques milliers de ligne dans la feuille résumé, j'en ai rajouté 500 avec des "x" pour que ça se rapproche de la réalité.
Quand j'ai essayé d'adapter ton code, en cliquant sur le bouton ça me supprimait la dernière ligne qui contenait des infos pour me rajouter la nouvelle (je suis vraiment trop nul 🥲🥲🥲)
 

Pièces jointes

  • Modèle (1) (2) (2) (5) (2) (1) (1).xlsm
    42.3 KB · Affichages: 2
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour Asso,

J'ai effectué tous les tests et tout fonctionne comme prévu !

c'était vraiment ce que je cherchais à faire

impeccable ! 😊



je n'ai pas réussi à adapter ton code pour que les informations se positionnent au bon endroit.

c'est bien pour ça que le demandeur doit fournir un fichier représentatif du cas réel ! ;) l'adaptation est faite dans le nouveau fichier.​

Les informations de la colonne en plus se trouve dans la feuille "Budget".
Est-il possible de reporter les informations de la colonne en fonction de la référence sur la feuille "Résumé" ?

c'est fait aussi dans le nouveau fichier. :)



En tout cas merci pour ton aide, c'était vraiment ce que je cherchais à faire et tu as réalisé ça avec brio !!!!
Si un jour tu passes dans le sud préviens moi je t'offre le café 😁😁😁😁

merci pour ton retour ! 😊



pour la suite, patiente un long moment : je vais de suite écrire un autre long post.​

soan
 

soan

XLDnaute Barbatruc
Inactif
Re,

Mode d'emploi

* sur la feuille "Résumé" ; note que Tableau3 est vide (à part les en-têtes).

* va sur la feuille "Budget" ; oh ! les budgets négatifs sont tous en blanc gras sur fond rouge ! c'est normal, et c'est fait par MFC (Mise en Forme Conditionnelle) ; j'aurais dû te le proposer plus tôt.

* va sur la feuille "Achat" ; c'est inchangé ; clique sur le bouton.

* ça va automatiquement sur la 2ème feuille "Budget", et comme il y a au moins un budget négatif, tu as un message d'avertissement (comme avant) ; là encore, les budgets négatifs sont tous en blanc gras sur fond rouge.

* clique sur le bouton OK de la boîte de dialogue "Budget(s) négatif(s)", et va sur la feuille "Résumé" ; c'est pas mal, hein ? ça te va ? mais attends : il va y avoir une 2ème version de ce fichier dans le post suivant.​

Code VBA

VB:
Option Explicit

Dim T

Private Sub WriteLig(j&, i&)
  Dim cel As Range, réf$, dsg$, bdg&, ect As String * 3: réf = T(i, 1): dsg = "?"
  With Worksheets("Budget")
    Set cel = .Columns(2).Find(réf, , -4163, 1, 1)
    If cel Is Nothing Then Exit Sub 'sortir de la sub si référence non trouvée
    dsg = .Cells(cel.Row, 3): bdg = .Cells(cel.Row, 5): ect = .Cells(cel.Row, 6)
  End With
  With Worksheets("Résumé").Cells(j, 2)
    .Value = Date
    .Offset(, 1) = Choose(Weekday(Date, 2), "Lundi", "Mardi", "Mercredi", _
      "Jeudi", "Vendredi", "Samedi", "Dimanche")
    .Offset(, 2) = "Achat"  'Type de mouvement
    .Offset(, 3) = "Frs X"  'Fournisseur
    .Offset(, 4) = réf      'Référence
    .Offset(, 5) = dsg      'Désignation
    .Offset(, 6) = T(i, 2)  'Montant commande (idem que Achat)
    .Offset(, 7) = ect      'Écart autorisé ("oui" ou "non")
    .Offset(, 8) = bdg      'Budget final
  End With
End Sub

Private Sub Bouton_Click()
  Dim cel As Range, bdg&, chn$, n&, i&, j&: Application.ScreenUpdating = 0
  With Worksheets("Achat")
    With .ListObjects("Tableau1")
      If .DataBodyRange Is Nothing Then Exit Sub
      n = .ListRows.Count
    End With
    T = .[E5].Resize(n, 2)
  End With
  With Worksheets("Budget")
    For i = 1 To n
      Set cel = .Columns(2).Find(T(i, 1), , -4163, 1, 1)
      If Not cel Is Nothing Then
        With .Cells(cel.Row, 5)
          bdg = .Value - T(i, 2): .Value = bdg
          If bdg < 0 Then _
            chn = chn & "* en ligne " & i + 1 & " : " & bdg & vbLf
        End With
      End If
    Next i
  End With
  With Worksheets("Résumé").ListObjects("Tableau3")
    'pour la première référence de la feuille "Achat"
    If .DataBodyRange Is Nothing Then
      WriteLig 3, 1: j = 3
    Else
      .ListRows.Add: j = .ListRows.Count + 2: WriteLig j, 1
    End If
    'pour les autres références de la feuille "Achat"
     For i = 2 To n
       .ListRows.Add: j = j + 1: WriteLig j, i
     Next i
  End With
  Worksheets("Budget").Select: Application.ScreenUpdating = -1
  If chn <> "" Then MsgBox chn, , "Budget(s) négatif(s)"
End Sub

soan
 

Pièces jointes

  • Modèle (1) (2) (2) (5) (2) (1) (1) - 1.xlsm
    32.4 KB · Affichages: 3