XL 2019 changer formules en macro

[biboune]

est-ce que quelqu'un pourrait me dire s'il est possible de changer les formules répétitives des colonnes K de la feuille "grilles" par une macro pour alléger le dossier ?
et une autre macro pour remplacer les formules de la colonne L.

merci
https://mon-partage.fr/f/t3Yl8stD/

 

[JBARBE]

Bonjour à tous, biboune,
Les macros de remplacement des formules n'allégeront certainement pas ton fichier très chargé !
De fait, lors de l'utilisation de ces macros, ça va drôlement ralentir l’exécution !
De plus, je n'ai pas bien compris ces formules qui débouchent sur aucun résultat ( la colonne P qui y est référencée est vide )
Bon courage !
Bonne journée !

 

[job75]

Bonjour biboune, JBARBE,

Voyez ce fichier sur c.joint.com et ce code dans Module 3 :

Dim d As Object 'mémorise la variable

Sub Calcul_K_L()
Dim c As Range
Set d = CreateObject("Scripting.Dictionary")
'---liste sans doublon---
For Each c In [P3:P92]
    If c <> "" Then d(c.Value) = ""
Next
'---traitement des plages---
With Sheets("Grilles").[K3:K43200] 'à adapter
    .ClearContents 'RAZ
    .Formula = "=IF(J3="""","""",K(A1:I3))"
    .Value = .Value 'supprime les formules
End With
With Sheets("Grilles").[L3:L43200] 'à adapter
    .ClearContents 'RAZ
    .Formula = "=IF(J3="""","""",L(A1:I3))"
    .Value = .Value 'supprime les formules
End With
End Sub

Function K(r As Range) As String
Dim tablo, i, n, j
tablo = r 'matrice, plus rapide
For i = 1 To 3
    n = 0
    For j = 1 To 9
        If d.exists(tablo(i, j)) Then n = n + 1
    Next j
    If n <> 5 Then Exit Function
Next i
K = "QUINE"
End Function

Function L(r As Range) As String
Dim tablo, i, n, j, nn
tablo = r 'matrice, plus rapide
For i = 1 To 3
    n = 0
    For j = 1 To 9
        If d.exists(tablo(i, j)) Then n = n + 1
    Next j
    If n = 5 Then nn = nn + 1
Next i
If nn = 3 Then L = "CARTON PLEIN" Else If nn = 2 Then L = "DOUBLE QUINE"
End Function

La macro Calcul_K_L entre les formules dans les 2 plages et ne garde que les valeurs.

Vous l'exécuterez où et quand vous voulez.

Pour tester j'ai mis des nombres aléatoires dans la plage [Edit] P3: P92.

A+

 

[job75]

Les résultats "QUINE" et "CARTON PLEIN" étant forcément sur la même ligne on gagnera en rapidité en n'utilisant que la fonction L :

Dim d As Object 'mémorise la variable

Sub Calcul_K_L()
Dim c As Range
Set d = CreateObject("Scripting.Dictionary")
'---liste sans doublon---
For Each c In [P3:P92]
    If c <> "" Then d(c.Value) = ""
Next
'---traitement des plages---
With Sheets("Grilles").[L3:L43200] 'à adapter
    .ClearContents 'RAZ
    .Formula = "=IF(J3="""","""",L(A1:I3))"
    .Value = .Value 'supprime les formules
    .Replace "CARTON PLEIN", "#N/A"
    On Error Resume Next 'si aucune SpecialCell
    Intersect(.Offset(, -1), .SpecialCells(xlCellTypeConstants, 16).EntireRow) = "QUINE" 'en colonne K
    .Replace "#N/A", "CARTON PLEIN"
End With
End Sub

Function L(r As Range) As String
Dim tablo, i, n, j, nn
tablo = r 'matrice, plus rapide
For i = 1 To 3
    n = 0
    For j = 1 To 9
        If d.exists(tablo(i, j)) Then n = n + 1
    Next j
    If n = 5 Then nn = nn + 1
Next i
If nn = 3 Then L = "CARTON PLEIN" Else If nn = 2 Then L = "DOUBLE QUINE"
End Function

Le fichier : https://cjoint.com/c/KHxpI4fcZsu