Microsoft 365 Convertir une formule en VBA

[ivan27]

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

 

[sylvanu]

Bonjour Ivan,
Un essai avec deux array :

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.

 

[MP59]

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.

 

[ivan27]

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]

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]

Bonjour Ivan27 et MP,

Ivan, votre formule est en D et est :

=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]

Bonsoir ivan27, sylvanu, MP59,

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

Voyez le fichier joint et cette macro :

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.

 

[job75]

Fichier (2) avec les colonnes J et AJ, l'adaptation de la macro est assez évidente.

 

[ivan27]

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