Addition en VBA ?

[Marboi]

Bonjour à vous tous,

ma colonne D est un cumul alimenté par la colonne B pour des recettes et C pour des dépenses. La fonction en D=B-C avec le report du cumul précédent et avec conditions fonctionne très bien. Le problème est qu'il faut la recopier vers le bas (en fonction du remplissage du tableau, bon ça c'est pas trop génant, encore que certains dans ma boîte ont du mal...) mais c'est surtout qu'elle commence à peser dans la feuille.
C'est pourquoi cette question : à votre avis, est-il possible d'utiliser une fonction VBA pour faire ce travail dans la colonne D de la 3ème ligne jusqu'à la ligne 65536 ?

 

[AeroPlanneur]

bonjour Marboi,

le plus simple, à la condition qu'il n'y ait pas de cellule vide (c-à-d de trou) dans la colonne 'C', est de selectionner la dernière cellule en 'D' où est inscrite la formule, de placer le pointeur de souris sur le coin inférieur droit de la-dite cellule, puis de double-cliquer pour recopier la formule jusqu'à la dernière ligne renseignée de la colonne 'C'.

cordialement

 

[Marboi]

Déjà merci de répondre, la recopie vers le bas fonctionne aussi mais le problème c'est que ça mutltiplie le poids du fichier par + de 30, donc ça devient lourd à l'ouverture, c'est pourquoi on le fait au fur et à mesure du remplissage du tableau..

 

[_Thierry]

Bonjour Marbois, AeroPlanneur, le Forum


Sans aucune formule, solution VBA à mettre dans le Private Module de la Feuille Concernée (Depuis Excel, Click Droit sur l'onglet de la dîte Feuille et dans le Menu Contextuel => 'Visualiser le Code')

Dans ce Private Module, copier/coller ce Code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Long, i As Long

If Application.Intersect(Target, Columns('B:C')) Is Nothing Then Exit Sub
    R = Target.Row
        If R = 1 Or R = 2 Then Exit Sub
        On Error GoTo Out
            If R = 3 Then
                Cells(R, 4) = Cells(R, 2) - Cells(R, 3)
            Else
                Cells(R, 4) = Cells(R - 1, 4) + Cells(R, 2) - Cells(R, 3)
            End If
        On Error GoTo 0
If Not R = Range('D65536').End(xlUp).Row Then
MsgBox 'Changement sur entrée antérieure, Recalcul Complet, veuillez Patienter'

    For i = R + 1 To Range('D65536').End(xlUp).Row
          Cells(i, 4) = Cells(i - 1, 4) + Cells(i, 2) - Cells(i, 3)
    Next
End If

Exit Sub
Out:

If Err = 13 Then
    Target = ''
Else
    MsgBox 'Erreur non gérée ' & Err.Number & ' ' & Err.Description
End If
End Sub

Je crois que ce devrait faire l'affaire, mais attention aux délais si on modifie la ligne 2 alors qu'on a rempli jusqu'en ligne 65000...

Bonne Fin de Journée
[ol]@+Thierry[/ol]

 

[_Thierry]

Hello cher Amigo José, re le Fil

Je ne t'avais point vu....

Non, je pense que notre ami veut éviter de 'Tirer' une Formule du style :
=SI(B17='';'';B17-C17+E16)
Jusqu'à la Saint GlinGlin... LOL

Bonne Soirée
[ol]@+Thierry[/ol]

EDITION !!!
Non plus sérieusement José, je pense que sur une grosses quantité de lignes il y a un gain de poids d'avoir des Valeurs Figées plutôt que des Formules avec des 'If' et même probablement double 'If' avec un 'Or' (pour les deux colonnes 'B' et 'C', plus les additions...

Message édité par: _Thierry, à: 14/05/2006 19:31

 

[_Thierry]

Re Amigo

Je ne suis pas si certain de ça, en fait, si on saisit normalement, (sans revenir en arrière, ce qui semble logique dans un Livre de Caisse) il n'y a aucun délai avec VBA.

Mais je taperai pas fort... promis lol

Bonne Soirée
[ol]@+Thierry[/ol]

 

[Marboi]

Merci Thierry, mais rien ne se passe !... J'ai recopier ta formule dans la page selon tes indications. J'ai peut-être oublié quelque chose ?
Jmps, je pensais que recopier les formules sur toute la colonne prendrait beaucoup plus de Ko dans le fichier qu'une Macro. J'ai refait un petit exemple sur une soixante de ligne qui pèse 400 Ko et la recopie simple de la formule juqu'à la ligne 65536 fait passer le fichier à pratiquement 4 Mo

 

[_Thierry]

Re Amigo, re Marboi

Je ne sais pas si tu as bien la même configuration de Fichier que j'ai interprété... Voici une Démo qui fonctionne...

Hi hi hi, oui oui José, je sais qu'on peut revenir en arrière, sinon je n'aurais pas écrit :
If Not R = Range('D65536').End(xlUp).Row Then
MsgBox 'Changement sur entrée antérieure, Recalcul Complet, veuillez Patienter'

D'ailleurs, le MsgBox sera à supprimer à mon avis...

Bon je vais me faire des Spaguettis ! Le temps que la macro tourne ils seront 'Aldente' lol

[ol]@+Thierry[/ol] [file name=XLD_VBA_Livre_De_Caisse_Auto.zip size=7946]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/XLD_VBA_Livre_De_Caisse_Auto.zip[/file]

 

[Marboi]

Merci Thierry,

Effectivement ça fonctionne.
Bonne pâtes !.... Spaghettis ? Avec sauce, gruyère et parmesan, j'espère.

Merci à vous trois.

Bonne soirée.