Mettre une formule en vba

Version imprimable

Voir 40 message(s) de cette discussion en une page

04/07/2017, 09h19
Invité

Bonjour,

J'ai essayé de convertir ta formule en VBA mais il y a un problème avec ce MATCH :

Code:

"MATCH('Effectif Niveaux'!$E:$E,'Competence Effectif'!$E:$E,0)

"

Je pense que le problème vient de là.
04/07/2017, 09h54
Menhir

Il ne te semble pas étrange d'avoir le même argument en paramètre 1 et en paramètre 2 ? 8O
Un conseil : teste la même fonction dans Excel, tu comprendras ce qui ne va pas.
04/07/2017, 10h58
matimatfr

Je fais des tests aussi, et je bloque aussi mais merci encore d'essayer pour moi.

@Menhir, la formule Excel exacte est celle là (voir fichier fourni dans les post précédents - Feuille "Effectifs Niveaux") :

Code:

=SI(INDIRECT("'Competence Effectif'!"&ADRESSE(EQUIV('Effectif Niveaux'!$E:$E;'Competence Effectif'!$E:$E;0);EQUIV('Effectif Niveaux'!$8:$8;'Competence Effectif'!$8:$8;0)))="OUI";"Niv 0 / Intégration";"")

Celle-ci fonctionne en mode Excel, c'est l'adaptation en VBA ou je bloque. Car à 350 Collaborateurs le fichier est lourd et prend du temps de calcul à chaque mise à jour. Sachant qu'il va être partagé, passé en mode VBA me semble une meilleure solution.

J'ai modifié un peu ta formule pour que les MATCH fonctionnent, logiquement elle est équivalente à l'ancienne (et plus logique je trouve), voilà où j'en suis :
Code:

1 2 3 4 5 6 7 Dim formule As String Dim res As Variant formule = "INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E9,'Competence Effectif'!$E1:$E19,0),MATCH('Effectif Niveaux'!G$8,'Competence Effectif'!$8:$8,0)))" res = Evaluate(formule) MsgBox res
Actuellement, tu dois avoir "OUI" qui est stocké dans res.
Je n'arrive pas encore à intégrer le IF à la formule, j'ai une erreur 2023 dans le res, je travaille dessus.

EDIT : Les modifications sur les MATCH ne correspondent que à la formule de la cellule G9 et avec le fichier que tu nous as fourni.

04/07/2017, 11h24
matimatfr

Super, je vois que tu as trouvé la solution. En mettant la formule initiale avec plage de cellules ça fonctionnait pas chez moi, j'aurai déjà du essayer de l'adapter à une case spécifique....
04/07/2017, 11h26
Menhir

Citation:

Envoyé par matimatfr

@Menhir, la formule Excel exacte est celle là (voir fichier fourni dans les post précédents - Feuille "Effectifs Niveaux") :

Code:

=SI(INDIRECT("'Competence Effectif'!"&ADRESSE(EQUIV('Effectif Niveaux'!$E:$E;'Competence Effectif'!$E:$E;0);EQUIV('Effectif Niveaux'!$8:$8;'Competence Effectif'!$8:$8;0)))="OUI";"Niv 0 / Intégration";"")

Je m'étonne de voir une zone en premier paramètre de la fonction EQUIV.
Ce ne serait pas une formule matricielle, par hasard ?
04/07/2017, 11h40
matimatfr

Citation:

Envoyé par Menhir

Je m'étonne de voir une zone en premier paramètre de la fonction EQUIV.
Ce ne serait pas une formule matricielle, par hasard ?

C'est effectivement ça, le but de cette formule est de trouver l'équivalence dans 2 tableaux semblables comme premier argument. Liste de 350 et plus de collaborateurs qui va amener à évoluer par des sorties ou des entrées voir des modifications. Et pour que les occurrences se calculent seules, j'ai effectivement intégré des zones à la formule.

C'est bon ! Après une mâtiné de recherche j'ai enfin trouvé un moyen de faire fonctionner ta formule :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Sub FormuleExcel()
 
    Dim ligne As Long
    Dim formule As String
    Dim res As String
 
    ligne = Sheets("Effectif Niveaux").Cells(Rows.Count, 1).End(xlUp).Row
 
    formule = "INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E9,'Competence Effectif'!$E1:$E" & ligne & ",0),MATCH('Effectif Niveaux'!G$8,'Competence Effectif'!$8:$8,0)))"
    res = Evaluate(formule)
    res = Evaluate("IF(""" & res & """=""OUI"", ""Niv 0 / Intégration"", """")")
 
 
End Sub

Essaye sa et regarde ce que tu as dans ton res. :)

04/07/2017, 14h13
matimatfr

Je viens de tester, tu as assuré sur ce coup là !! :D:D:D

J'aurai pas pensé à décomposé en deux et intégrer la recherche de la dernière ligne non vide

Me reste plus qu'à regarder et bosser sur ton post précédent pour boucler sur toutes les cellules !

Merci déjà pour le temps passer sur cela :mrgreen:
04/07/2017, 14h16
Invité

De mon côté, j'ai adapté à la boucle que je t'ai montré précédemment, le temps d'exécution est de 45 secondes environ maintenant, c'est assez long. :?
04/07/2017, 15h39
matimatfr

Citation:

Envoyé par Oudouner

De mon côté, j'ai adapté à la boucle que je t'ai montré précédemment, le temps d'exécution est de 45 secondes environ maintenant, c'est assez long. :?

Je suis encore vraiment à la rue moi, je suis toujours en adaptation :)
04/07/2017, 15h41
Invité

Citation:

Envoyé par matimatfr

Je suis encore vraiment à la rue moi, je suis toujours en adaptation :)

On en reparlera quand tu auras fini d'adapter. :P

Citation:

Envoyé par Oudouner

On en reparlera quand tu auras fini d'adapter. :P

Certes, certes, faut que j'arrête je crois pour ce soir, je fumes là et du coup je pense que je deviens un boulet :traine:

Bref, j'ai adapté ton 1er code à mon tableau sur l'exemple envoyé, mais là faut que j'intègre la formule....

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Sub FormuleExcel()
 
    Dim ligne As Long
    Dim formule As String
    Dim res As String
    Dim i As Integer
    Dim j As Integer
    Dim tablo(1 To 11, 1 To 385) As Integer
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    ligne = Sheets("Effectif Niveaux").Cells(Rows.Count, 1).End(xlUp).Row
 
    formule = "INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E9,'Competence Effectif'!$E1:$E" & ligne & ",0),MATCH('Effectif Niveaux'!G$8,'Competence Effectif'!$8:$8,0)))"
    res = formule
    res = "IF(""" & res & """=""OUI"", ""Niv 0 / Intégration"", """")"
 
    'Ici on calcule la table d'addition en la stockant dans notre tableau
    For i = 1 To 11
 
        For j = 1 To 385
 
            tablo(i, j) = Cells(i + 8, 7) + Cells(1, j + 6)
 
        Next j
 
    Next i
 
    'Puis on affiche notre table dans la feuille (à modifier dans ton cas bien sur) sans reboucler sur le  tableau
    Sheets("Effectif Niveaux").Range("G9:OA19").Value = tablo
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
 
 
End Sub

Je reviendrai vers toi quand j'aurai réussi, enfin si j'y arrive :pan:

05/07/2017, 01h21
RyuAutodidacte

Bonsoir,

Je sais j'avais demander le fichier, mais avant hier soir un grand coup de fatigue m'est tombé dessus :aie: :mrgreen:
Bon ça faisait longtemps que je n'étais pas rentré dans les formules et j'ai fait plusieurs tests le temps de décortiqué le fichier et faire les formules ou je me sentais plus à mon aise (oui ça fait un moment que j'en fait plus :()

Donc je suis reparti de zéro, tout marche même ta formule de départ (le cheminement d'où j'ai commencé le temps de me remettre dans le bain) :

- déjà utilisation de :

Code:

Debug.Print Selection.Formula

pour obtenir les formules en anglais

1 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(SUMPRODUCT(('Competence Effectif'!$E$9:$E$19='Effectif Niveaux'!$E9)*ROW('Competence Effectif'!$E$9:$E$19)),SUMPRODUCT(('Competence Effectif'!$G$8:$O$8='Effectif Niveaux'!G$8)*COLUMN('Competence Effectif'!$G$8:$O$8))))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(SUMPRODUCT(('Competence Effectif'!$E$9:$E$19='Effectif Niveaux'!$E9)*ROW('Competence Effectif'!$E$9:$E$19)),SUMPRODUCT(('Competence Effectif'!$G$8:$O$8='Effectif Niveaux'!G$8)*COLUMN('Competence Effectif'!$G$8:$O$8))))=""OUI"",""Niv 0 / Intégration"","""")"

2 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(SUMPRODUCT(('Competence Effectif'!$E$9:$E$19=$E9)*ROW('Competence Effectif'!$E$9:$E$19)),SUMPRODUCT(('Competence Effectif'!$G$8:$O$8=G$8)*COLUMN('Competence Effectif'!$G$8:$O$8))))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(SUMPRODUCT(('Competence Effectif'!$E$9:$E$19=$E9)*ROW('Competence Effectif'!$E$9:$E$19)),SUMPRODUCT(('Competence Effectif'!$G$8:$O$8=G$8)*COLUMN('Competence Effectif'!$G$8:$O$8))))=""OUI"",""Niv 0 / Intégration"","""")"

3 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(MATCH($E9,'Competence Effectif'!$E$9:$E$19,0)+8,SUMPRODUCT(('Competence Effectif'!$8:$8=G$8)*COLUMN('Competence Effectif'!$8:$8))))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH($E9,'Competence Effectif'!$E$9:$E$19,0)+8,SUMPRODUCT(('Competence Effectif'!$8:$8=G$8)*COLUMN('Competence Effectif'!$8:$8))))=""OUI"",""Niv 0 / Intégration"","""")"

4 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(MATCH($E9,'Competence Effectif'!$E:$E,0),SUMPRODUCT(('Competence Effectif'!$8:$8=G$8)*COLUMN('Competence Effectif'!$8:$8))))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH($E9,'Competence Effectif'!$E:$E,0),SUMPRODUCT(('Competence Effectif'!$8:$8=G$8)*COLUMN('Competence Effectif'!$8:$8))))=""OUI"",""Niv 0 / Intégration"","""")"

5 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(MATCH('Effectif Niveaux'!$E:$E,'Competence Effectif'!$E:$E,0),MATCH('Effectif Niveaux'!$8:$8,'Competence Effectif'!$8:$8,0)))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E:$E,'Competence Effectif'!$E:$E,0),MATCH('Effectif Niveaux'!$8:$8,'Competence Effectif'!$8:$8,0)))=""OUI"",""Niv 0 / Intégration"","""")"

Sachant que le code doit être exécuté sur la feuille 'Effectif Niveaux'! nul besoin de le spécifier alors :
6 :

Code:

=IF(INDIRECT("'Competence Effectif'!"&ADDRESS(MATCH($E:$E,'Competence Effectif'!$E:$E,0),MATCH($8:$8,'Competence Effectif'!$8:$8,0)))="OUI","Niv 0 / Intégration","")

Code:

Range("G9:O19").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH($E:$E,'Competence Effectif'!$E:$E,0),MATCH($8:$8,'Competence Effectif'!$8:$8,0)))=""OUI"",""Niv 0 / Intégration"","""")"

Voilà, toutes les formules marchent et directement (en une fois) et on peut y insérer des variables si besoins afin de créer un adaptation auto sur le fichier
05/07/2017, 09h21
Invité

Bonjour,

J'ai essayé d'adapter cette formule à un Evaluate, mais sa n'aboutit pas, tu as une idée Ryu ?

Code:

"IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH($E:$E,'Competence Effectif'!$E:$E,0),MATCH($8:$8,'Competence Effectif'!$8:$8,0)))=""OUI"",""Niv 0 / Intégration"","""")"

Citation:

Envoyé par Oudouner

On en reparlera quand tu auras fini d'adapter. :P

Bon, beh j'ai fais des tests, et pour le moment sont pas vraiment concluant pour moi, m'affiche la formule dans les cellules et non le résultat lol

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Public Sub FormuleExcel()
 
    Dim ligne As Long
    Dim formule As String
    Dim res As String
    Dim finale As String
    Dim i As Integer
    Dim j As Integer
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    ligne = Sheets("Effectif Niveaux").Cells(Rows.Count, 1).End(xlUp).Row
 
    formule = "INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E:$E,'Competence Effectif'!$E:$E" & ligne & ",0),MATCH('Effectif Niveaux'!$8:$8,'Competence Effectif'!$8:$8,0)))"
    res = formule
    finale = "IF(""" & res & """=""OUI"", ""Niv 0 / Intégration"", """")"
 
    For i = 9 To 19
    For j = 1 To 9
 
      Range("G" & i).Formula = finale
 
    Next j
    Next i
 
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

05/07/2017, 09h50
matimatfr

EDIT :

J'avais pas vu vos 2 réponses....:weird:

@ Ryu : merci pour ton boulot et ta patience également, je vois que tu as réussi à adapter la formule telle qu'elle était ! :):)
05/07/2017, 10h36
RyuAutodidacte

Re,

Elle marche direct en vba
Je ne l'ai pas préciser mais je pense que vous vous en doutez,
- sur chaque partie j'ai mis d'abord la formule traduite en anglais (comme cela c'est compatible sut toutes région d'Excel)
puis en dessous la partie faite en VBA

Dsl mais en journée je suis surchargé de taf, donc je vais suivre en jetant un coup d'oeil par ci par là

oui pour la formule comme dit avant (par @unparia) c'est juste une histoire d'écriture

as tu testé ??

PS : je suis sur Mac tout fonctionner logiquement il en va de même sur PC, mais dans le cas où il y a un souci, je testerai sur PC

Voici ce que j'ai de mon côté :

1ère méthode :
On utilise une variable tablo qui va être remplie grâce la fonction Evaluate (qui permet d'exécuter ta formule Excel)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Public Sub matima()
 
    Dim i As Integer
    Dim j As Integer
    Dim ligne As Long
    Dim colonne As Long
    Dim tablo() As Variant
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    colonne = Cells(8, Columns.Count).End(xlToLeft).Column
    ligne = Sheets("Effectif Niveaux").Cells(Rows.Count, 1).End(xlUp).Row
 
    ReDim tablo(1 To ligne - 8, 1 To colonne - 6)
 
    'Ici on calcule la table d'addition en la stockant dans notre tableau
    For i = 1 To UBound(tablo, 1)
 
        For j = 1 To UBound(tablo, 2)
 
            If Evaluate("INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH('Effectif Niveaux'!$E" & i + 8 & ",'Competence Effectif'!$E1:$E" & ligne & ",0),MATCH('Effectif Niveaux'!" & Split(Cells(1, j + 6).Address, "$")(1) & "$8,'Competence Effectif'!$8:$8,0)))") Like "OUI" Then
 
                tablo(i, j) = "Niv 0 / Intégration"
 
            Else
 
                tablo(i, j) = ""
 
            End If
 
        Next j
 
    Next i
 
    Sheets("Effectif Niveaux").Range("G9:" & Split(Cells(1, 380).Address, "$")(1) & ligne).Value = tablo
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

Temps d'exécution : 26 secondes.

2ème méthode :
Beaucoup plus bourrin à mon goût, on écrit ta formule dans une seule cellule (via la Formula), on étire cette cellule au reste de ton tableau. On fait un copier coller de ton tableau Excel en ne gardant que les valeurs (ce qui permet d'enlever les formules de ton tableau Excel).

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Sub matima2()
 
    Dim temps As Date
    Dim debut As Date
    Dim fin As Date
    Dim ligne As Integer
    Dim formule As String
    Dim colonne As Long
    Dim nomColonne As String
 
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
 
    debut = Time
 
    colonne = Cells(8, Columns.Count).End(xlToLeft).Column
    ligne = Sheets("Effectif Niveaux").Cells(Rows.Count, 1).End(xlUp).Row
    nomColonne = Split(Cells(1, colonne).Address, "$")(1)
 
    Range("G9").Formula = "=IF(INDIRECT(""'Competence Effectif'!""&ADDRESS(MATCH($E:$E,'Competence Effectif'!$E:$E,0),MATCH($8:$8,'Competence Effectif'!$8:$8,0)))=""OUI"",""Niv 0 / Intégration"","""")"
 
    Range("G9").AutoFill Destination:=Range("G9:G" & ligne), Type:=xlFillDefault
    Range("G9:G" & ligne).AutoFill Destination:=Range("G9:" & nomColonne & ligne), Type:=xlFillDefault
 
    With Range("G9:" & nomColonne & ligne)
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End With
 
    fin = Time
    temps = debut - fin
    MsgBox temps
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
End Sub

Temps d'exécution : 17 secondes.

05/07/2017, 11h10
Invité

Citation:

Envoyé par RyuAutodidacte

Re,

Elle marche direct en vba
Je ne l'ai pas préciser mais je pense que vous vous en doutez,
- sur chaque partie j'ai mis d'abord la formule traduite en anglais (comme cela c'est compatible sut toutes région d'Excel)
puis en dessous la partie faite en VBA

Dsl mais en journée je suis surchargé de taf, donc je vais suivre en jetant un coup d'oeil par ci par là

oui pour la formule comme dit avant (par @unparia) c'est juste une histoire d'écriture

as tu testé ??

PS : je suis sur Mac tout fonctionner logiquement il en va de même sur PC, mais dans le cas où il y a un souci, je testerai sur PC

J'ai testé tes formules et elles marchent nickel. Le problème c'est que le but initial était de réduire la taille du fichier en enlevant les formules excel des cellules du tableaux, d'où l'utilisation d'Evaluate.

Voir 40 message(s) de cette discussion en une page