Résolu Microsoft 365 Convertir une formule en VBA

ivan27

XLDnaute Occasionnel
Bonjour à tous,

Pourriez-vous me donner un coup de main pour convertir en VBA, la formule en colonne ''S'' sur mon fichier test ?
Explications, formule et résultat attendu sur le fichier joint.
Avec mes remerciements anticipés,
Bien cordialement,
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

_Thierry

XLDnaute Barbatruc
Bonjour @ivan27 , le Forum

Le voici avec un Algo VBA, mais c'est plus pour le fun, car si ta fonction fonctionne, je ne sais pas pourquoi privilégier un solution par VBA...
Il peut y avoir du pour et du contre :

Avantage :
* Les Utilsateurs ne risquent pas de détruire la formule
Inconvénients :
* Le Classeur devient un XLSM et donc avec des possibles restrictions de circulation
* Si il y a beaucoup de données ca peut prendre du temps (Pas optimisé avec Tableau VBA pour le moment)


Bonne journée
@+Thierry
 
Ce message a été identifié comme étant une solution!

Fichiers joints

ivan27

XLDnaute Occasionnel
Re-bonjour le forum, Bonjour Thierry,
Merci pour cette proposition,
Mon fichier d'exploitation fait environ 60.000 lignes et il est utilisé par plusieurs personnes d'où ma demande.
Je veux bien une proposition optimisée qui accélérerait le temps de calculs.
Bonne fin de journée
Ivan
 

_Thierry

XLDnaute Barbatruc
Re Bonjour Ivan, le Forum

Sur 60000 lignes (sur les deux tableaux BD et Tariff chacun 60,000 lignes ?) ca va mouliner un bail et pour créer les Tableaux VBA Array Dynamiques ca va être coton aussi car en voyant l'Algo sur Cells on voit bien que ça part dans tous les sens, et tout ça sans guarantie que la Formurle actuelle ira X fois plus vite de toutes les façons...

VB:
Option Explicit

Sub Calculator()
Dim WB As Workbook
Dim WSBD As Worksheet, WSTarif As Worksheet
Dim RangeBd As Range, RangeTarif As Range
Dim CellBD As Range, CellTarif As Range


Set WB = ThisWorkbook
Set WSBD = WB.Worksheets("BD")
Set WSTarif = WB.Worksheets("TARIF")

Set RangeBd = WSBD.Range("A2:A" & WSBD.Range("A1000").End(xlUp).Row)
Set RangeTarif = WSTarif.Range("A2:A" & WSTarif.Range("A1000").End(xlUp).Row)



For Each CellBD In RangeBd
    For Each CellTarif In RangeTarif
   
        If CellTarif = CellBD.Offset(0, 14) Then
                If CellBD.Offset(0, 15) = "" Then 'P = vide
                        If CellTarif.Offset(0, 2) = 0 Then
                            CellBD.Offset(0, 19) = CellTarif.Offset(0, 1) + CellBD.Offset(0, 16)
                        Else
                            CellBD.Offset(0, 19) = CellTarif.Offset(0, 1) + (CellTarif.Offset(0, 2) * CellBD.Offset(0, 9)) + CellBD.Offset(0, 16)
                        End If
               
                Else
                    CellBD.Offset(0, 19) = CellBD.Offset(0, 15) + CellBD.Offset(0, 16)
               
                End If
       
        End If
    Next CellTarif

If (CellBD.Offset(0, 13) / CellBD.Offset(0, 9)) < 0.9 Then
    CellBD.Offset(0, 19) = CellBD.Offset(0, 19) - 20
End If

Next CellBD

End Sub
Ce qui est important et primordial avant d'aller plus loin c'est que tu testes en l'état si le moteur de l'Algo traite bien tous les cas de figures de calcul correctement car tu ne dis rien ?

Si le "moteur" est validé après on pourra le booster avec des Array Sequentielles et quelques heures de boulots avec les tests...

Perso je ne vais pas avoir trop de temps pour m'embarquer la dedans pour le moment, mais je suis certain que pas mal de contributeurs "adorent" les tablos VB !! ;)

Bien à toi, Bien à vous
@+Thierry
 

ivan27

XLDnaute Occasionnel
Re-bonjour le forum, Thierry,
J'ai testé sur une base qui traite tous les cas et je n'ai pas rencontré d'erreur sur les calculs.
Juste un problème sur des données au format texte que j'ai su régler.
Si quelqu'un pouvait me proposer la même chose avec des tableaux, ça serait parfait !
Bien cordialement,
 

ivan27

XLDnaute Occasionnel
Re bonsoir Thierry, le forum,

Après réflexion je vais utiliser ton code.
Un tableau serait probablement plus rapide mais je serai incapable de le modifier en cas de besoin.
Je vais trier ma BD par dates décroissantes et faire un calcul uniquement sur les enregistrements récents; c'est plus logique que de recalculer toute la base lors de l'ajout d'un nouvel enregistrement.
J'ai fait le test avec un timer est ça ne prend que 0,5 s pour 2000 lignes...
Je clôture ce sujet.
Encore merci et à très bientôt
Ivan
 

_Thierry

XLDnaute Barbatruc
Bonjour @ivan27, le Forum

Pour l'exercice, je l'ai fait en Deux Tableaux "Range" et un Tableau Array Sequentielle, finalement le "moteur" est exactement le même, donc pas trop difficile à adapter et pour toi, par la suite, pour le modifier en cas de besoin (J'ai laissé les deux algos, comme ça facile de s'y retrouver)

Je te laisse découvrir et tester les Timers sur les vrais volumes.... (Car là pas de différence flagrante sur le fichier test)

Bien à toi, à vous
@+Thierry
 
Ce message a été identifié comme étant une solution!

Fichiers joints

ivan27

XLDnaute Occasionnel
Bonjour Thierry, le forum,
Je regarde ce week-end et je te fais un retour lundi au plus tard.
Bonne fin de journée
Ivan
 

ivan27

XLDnaute Occasionnel
Bonsoir Thierry, le forum,
Finalement j'ai eu le temps de faire les tests ce soir sur une base de 66000 lignes.
1,8 s pour ta deuxième proposition contre 28,57 s pour la première.
Je te réitère mes remerciements
Bon week-end
Ivan
 

_Thierry

XLDnaute Barbatruc
Bonsoir @ivan27, le Forum

Ah oui sur 66,000 lignes il n'y a pas photo, plus que 15 x plus rapide, mais ce n'est pas surprenant, tout se passe en RAM, sauf quand il resize et transpose la colonne calculée (il faut bien ! ;))

Dans la base "Tarif" il y a aussi plus de lignes ? (55 seulements dans l'exemple)

J'espère que celà te sera utile, mais :
faire un calcul uniquement sur les enregistrements récents; c'est plus logique que de recalculer toute la base lors de l'ajout d'un nouvel enregistrement.
Reste quand même d'actualité si tu n'as pas besoin de mettre à jour toute la base (surtout si les tarifs augmentent et seraient supposés de rester figés pour le passé...)

Bon week-end à toi aussi
@+Thierry
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas