Microsoft 365 Convertir une formule en VBA

ivan27

XLDnaute Occasionnel
Bonjour à tous,

Sur le classeur en pièce jointe une formule en colonne D, qui m'avait été proposée sur le forum et qui fonctionne parfaitement bien tant que la liste à traiter ne dépasse pas quelques centaines de lignes.
Je viens de faire un test sur une BD de 85000 lignes et la validation de la première cellule a pris 45 secondes. Autant vous dire que je n'ai même pas essayé de tirer la formule vers le bas !
Aussi, serait-il possible de convertir cette formule en VBA et d’accélérer le traitement ?
Ma BD d'exploitation n'est pas sous forme de tableau.
Référence en colonne B, Libellé en colonne J et résultat attendu en colonne AJ.
Merci d'avance pour votre aide.
Ivan
 

Fichiers joints

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Ivan,
Un essai avec deux array :
Code:
Sub Calcule()
T0 = Timer
Dim tablo, R()
Derlig = Application.WorksheetFunction.CountA(Range("A:A"))
ReDim R(Derlig)
tablo = Range("A1:B" & Derlig)
For L = 2 To Derlig
    If tablo(L, 2) Like "*VENTE*" Then
        If tablo(L, 1) > 0 Then
            R(L - 1) = 1
        End If
    Else
        R(L - 1) = 0
    End If
Next L
Cells(1, 3).Resize(UBound(R)) = Application.Transpose(R)
MsgBox Round(Timer - T0, 3) & " s"
End Sub
Mais il n'est pas dit que cela soit plus rapide que des formules.
 

Fichiers joints

Dernière édition:

MP59

XLDnaute Occasionnel
Bonjour Ivan27 et Sylvanu,
la fonction transpose étant limitée un pb se posait avant la ligne 35000.
je me suis permis de modifier la macro de Sylvanu, en supprimant la fonction transpose et un des 2 tableaux (j'ai supprimé le R).
le tout est très rapide.
 

Fichiers joints

ivan27

XLDnaute Occasionnel
Bonsoir le forum, Sylvanu, MP59,
Je vous remercie pour vos propositions.
Les premiers tests sont concluants et on a pas besoin de regarder le chrono pour se rendre compte que c'est beaucoup plus rapide.
Par contre, auriez-vous l'amabilité d'adapter votre code pour prendre en compte ma BD d'exploitation comme stipulé en post1 :
''Référence en colonne B, Libellé en colonne J et résultat attendu en colonne AJ''
Je vous réitère mes remerciements
Bonne soirée
Ivan
 

ivan27

XLDnaute Occasionnel
Bonsoir Messieurs, le forum,
Je suis désolé mais après contrôle du résultat, le code ne fait pas la même chose que la formule; il manque une partie.
Partie1 : Si on trouve le mot "VENTE" en colonne B alors on écrit 1 en colonne C, sinon 0. (ça c'est bon)
Partie 2 : Si on a écrit ''1'' en colonne C alors on note la référence A et si d'autres références identiques existent dans la colonne A, alors on écrit également ''1'' en colonne C (même en l'absence du mot 'VENTE' sur la ligne)
Bien cordialement,
Ivan
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Ivan27 et MP,

Ivan, votre formule est en D et est :
VB:
=SI(NB.SI.ENS(Data[Libellé];"*VENTE*";Data[Référence];Data[[#Cette ligne];[Référence]])>0;1;0)
Il n'y a aucune action sur la colonne C.
Et quel rapport avec votre post #4 :
''Référence en colonne B, Libellé en colonne J et résultat attendu en colonne AJ''
Maintenant on parle de colonnes J et AJ.
Dernier point :
Si on a écrit ''1'' en colonne C alors on note la référence A et si d'autres références identiques existent dans la colonne A, alors on écrit également ''1'' en colonne C
Si on a écrit ''1'' en colonne C qu'importe les réf identiques en colonne A puisqu'en C on a déjà un "1".

Pourriez vous être plus clair ?
 

job75

XLDnaute Barbatruc
Bonsoir ivan27, sylvanu, MP59,

J'ai recopié le tableau du fichier post #1 sur 85 000 lignes.

Voyez le fichier joint et cette macro :
VB:
Private Sub CommandButton1_Click()
Dim t#, critere$, tablo, d As Object, i&
t = Timer
critere = CStr([D1]) 'critère à adapter
With [A1].CurrentRegion
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    If FilterMode Then ShowAllData
    tablo = .Resize(, 2) 'matrice, plus rapide
End With
'---comptage---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    If CStr(tablo(i, 2)) Like critere Then d(CStr(tablo(i, 1))) = 1
Next i
'---tableau des résultats---
tablo(1, 1) = critere
For i = 2 To UBound(tablo)
    tablo(i, 1) = -d.exists(CStr(tablo(i, 1)))
Next i
'---restitution---
[D1].Resize(UBound(tablo)) = tablo
MsgBox "Durée du calcul " & Format(Timer - t, "0.00 \s")
End Sub
Elle s'exécute en 0,23 seconde chez moi et fait la même chose que la formule NB.SI.ENS du post #1.

Bonne nuit.
 

Fichiers joints

Dernière édition:

ivan27

XLDnaute Occasionnel
Bonjour le forum,
Merci job75 pour cette proposition.
J'ai effectivement pu adapter ton code à ma BD.
Bonne fin de journée
Ivan
 

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