Microsoft 365 Isoler, convertir et calculer une chaîne de caractères entre parenthèses

[manu_tella]

Bonjour à tous,

Suite à un coup de main non négligeable des membres je reviens vers vous pour compléter mon code car je fais face a un use-case que je n'arrive pas à gérer.
Je cherche à traiter une chaîne de caractères bien spécifiquement avec le traitement des opérations entre parenthèses en priorité.
Je ne peux malheureusement pas partager le fichier car les données sont confidentielles mais je vais tenter d’être le plus clair possible dans la demande.

Au départ j'ai variable string type :

APS = (Banane OR fraise) AND NOT (pomme OR Groseille)

avec une matrice qui fonctionne j'arrive a convertir mes fruits et mes légumes en un expression de type:

APS = (1 OR 0) AND NOT (0 OR 1)

et là ou je remplaçais les OR et les AND par des opérations mathématiques je me rends compte que le le cas du AND NOT pose problème, il me faudrait d'abord calculer ce qui est présent dans la parenthèse.
j'imaginais d'abord remplacer les OR et les AND par des + et des * sans tenir compte des AND NOT ou OR NOT
pour arriver à cette étape intermédiaire:
APS = (1 + 0) AND NOT (0 + 1)
APS = (1) AND NOT (1)

comment est-il possible de créer un calcul intermédiaire dans mon code pour arriver à cette étape ? je pensais passer par un split et en faisant une évaluation de chaque calcul entre parenthèse et ainsi à la fin, remplacer les chaines AND NOT (1) ou AND NOT (0) par * 0 et * 1?

d'avance merci pour votre aide

manu

 

[job75]

C'est très facile à comprendre : Evaluate évalue les formules des feuilles de calcul Excel.

(0 OR 1) n'est pas une formule de feuille de calcul

OR(0,1) est une formule de feuille de calcul.

 

[manu_tella]

Bonjour à tous,

En creusant un peu je me rend compte qu'en fait je cherche à convertir une variable string en instruction ce qu'excel ne semble pas capable de faire directement. Je me suis donc dis qu'en passant par un fichier txt ce serait peut être possible.

J'arrive donc à exporter dans un .txt un contenu de la forme:

Attribute VB_Name = "filtering_module"
Option Explicit

sub filtering_projet()
sheets("cible").cells(1,1) = 0
sheets("cible").cells(2,1) = 0
sheets("cible").cells(3,1) = 1 AND 0
sheets("cible").cells(4,1) = 0 OR 0
sheets("cible").cells(5,1) = 0 OR 0 OR 0
sheets("cible").cells(6,1) = 0 OR 0 OR 0
sheets("cible").cells(7,1) = 0 AND (1 OR 1)
sheets("cible").cells(8,1) = 0 AND (0 OR 1 OR 0) AND 1
...
end sub

j'enregistre ce .txt en .bas,
j'importe le .bas dans mon code par la fonction

ThisWorkbook.VBProject.VBComponents
.Import "adresse_de_mon_fichier.bas"

et ensuite l'idée c'est de faire appel a ce nouveau module à l’intérieur de ma procédure via "call filtering_projet"

mais voila tout n'est pas si simple:

- la première difficulté est liée a l'import du module... je dois nécessairement avoir un module nommé filtering_module déjà présent sinon j'ai une erreur à l'appel de la procédure: "sub ou fonction non définie"
Si j'importe le module alors qu'il est déjà existant alors il me l’incrémente d'un "_1", il faut que je passe par une commande de renommage du premier module, puis commande de suppression pour l'import du nouveau module (la suppression n’étant pas appliquée en cours de procédure...)... là c'est déjà compliqué

- la seconde difficulté est lié à la taille de la procédure...
dans mon cas le module importé fait plus de 4000 lignes et donc => Procédure trop grande
il faudrait que je split le module mais là ça commence à devenir beaucoup trop complexe pour un amateur comme moi.

J'ai un peu l'impression que je me tord le cerveau dans l'histoire...
Il y a surement moyen de faire plus simple.

manu

 

[job75]

Bonjour manu_tella,

J'ai un peu l'impression que je me tord le cerveau dans l'histoire...

Un peu ? Vous jouez les apprentis sorciers alors que vos connaissances en VBA sont très faibles

A+

 

[job75]

Voyez le fichier joint avec la macro filtering_projet complétée :

Sub filtering_projet()
Dim i&, x$
With Sheets("cible")
    .Cells(2, 2) = 0
    .Cells(3, 2) = 0
    .Cells(4, 2) = 1 And 0
    .Cells(5, 2) = 0 Or 0
    .Cells(6, 2) = 0 Or 0 Or 0
    .Cells(7, 2) = 0 Or 0 Or 0
    .Cells(8, 2) = 0 And (1 Or 1)
    .Cells(9, 2) = 0 And (0 Or 1 Or 0) And 1
    For i = 2 To 9
        x = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule.Lines(i + 2, 1)
        .Cells(i, 1) = UCase(Mid(x, InStr(x, "=") + 2))
    Next
    .Columns(1).AutoFit 'ajustement largeur
End With
End Sub

Pour pouvoir accéder au VBAProject il faut avoir coché l'option Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

 

[manu_tella]

Bonjour le forum, bonjour Job75,

Encore merci pour le temps passé sur ma question.
En effet je ne connais pas grand chose à vba et crois moi c'est très frustrant. Mais comme je suis positif, je vois là une grosse marge de progression.
De ce que je comprends du code du classeur(1), ça ne colle pas à mon besoin. La partie cell(x,y) ne peut pas être écrite dans la macro puisque cette partie n'est fixe et surtout dans mon cas elle ne contient pas que 9 lignes mais plus de 4000 (j'ai limité à quelques exemples). (Rien n'est fixe dans l'histoire ni le nombre de ligne, ni les formules; d'où mon idée de faire un code dynamique en important un module construit à partir d'un fichier texte.... => un vrai fiasco)

Je mets dans ce post un fichier plus complet avec le morceau de mon code qui permet de convertir l'expression de fruits/légumes en formules binaires à partir de différents filtres élaborés dans une matrice.
Ce que je n'arrive pas à faire c'est l’étape suivante qui converti ces formules en résultat type 0/1.

PS1: La première proposition basée sur l'analyse des chaines de caractères en remplaçant les AND/OR et NOT fonctionne mais laisse passer 5/10% des cas qui ont une syntaxe un peu marginale. voila pourquoi je creuse une solution plus robuste.

PS2: je l'accorde sur la conversion j’aurais pu passer par une bibliothèque pour limiter le temps de calcul mais ça, je le ferais plus tard

encore merci

belle journée à vous

manu

edit: modification de la PJ

 

[job75]

Bonjour manu_tella,

Faudrait savoir ce que vous voulez !

Appliquez la macro de mon post #10 et n'en parlons plus !

A+

 

[manu_tella]

Bonjour,

Appliquez la macro de mon post #10 et n'en parlons plus !

PS1: La première proposition basée sur l'analyse des chaines de caractères en remplaçant les AND/OR et NOT fonctionne mais laisse passer 5/10% des cas qui ont une syntaxe un peu marginale. voila pourquoi je creuse une solution plus robuste.

manu

 

[job75]

Bon voyez le fichier joint et le code du Module1 (pas très facile à comprendre) :

Option Explicit
Dim flag As Boolean 'mémorise la variable

Sub project_filtering()
Application.ScreenUpdating = False
If Not flag Then
    Dim F As Worksheet, P As Range, i As Variant, c As Range, n&
    Set F = Sheets("DIV")
    Set P = [A3].CurrentRegion.Offset(1)
    P.Columns(2).Copy P.Columns(3)
    P.Columns(4) = ""
    '---3ème colonne---
    i = Application.Match([A1], F.Rows(5), 0)
    If IsError(i) Then Exit Sub
    P.Columns(3).Replace "~*", 1, xlPart
    For Each c In F.Columns(2).SpecialCells(xlCellTypeConstants)
        If c.Row > 6 Then P.Columns(3).Replace c, IIf(c(1, i - 1) = "", 0, 1)
    Next
    '---ajoute le code sous la ligne 27 pour remplir la 4ème colonne---
    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
        For i = 1 To P.Rows.Count
            If P(i, 3) <> "" Then n = n + 1: .InsertLines 27 + n, "Range(""" & P(i, 4).Address(0, 0) & """) = " & P(i, 3)
        Next
    End With
    ThisWorkbook.Names.Add "n", n 'mémorise n dans un nom défini
End If
'---cette ligne est la ligne 27---
If Not flag Then Application.OnTime 1, "Executer" 'lancement différé
End Sub

Private Sub Executer()
flag = True
project_filtering 'lance la macro pour exécuter le code ajouté
flag = False
ThisWorkbook.VBProject.VBComponents("Module1").CodeModule.DeleteLines 28, [n] 'supprime le code ajouté
End Sub

Je rappelle que l'option indiquée au post #19 doit être cochée.

Nota : en feuille DIV j'ai mis les légumes avant les fruits pour que Poireau soit remplacé avant Poire.

Bonne nuit.

 

[job75]

Bonjour manu_tella, le forum,

Pour tester j'ai copié les lignes 4 à 34 sur 6200 lignes.

La macro précédente beugue avec le message Procédure trop grande.

Cela se produit chez moi quand le nombre de lignes dépasse environ 1770 lignes.

Pour y remédier, dans ce fichier (2) la macro traite le tableau par paquets de 500 lignes :

Option Explicit
Dim flag1 As Boolean, flag2 As Boolean 'mémorise les variables

Sub project_filtering()
Dim F As Worksheet, P As Range, i As Variant, c As Range
Application.ScreenUpdating = False
If Not flag1 Then
    ThisWorkbook.Names.Add "t", Timer 'nom défini pour mesurer la durée
    ThisWorkbook.Names.Add "paquet", 500 'nom défini, adapter le nombre
    Set F = Sheets("DIV")
    Set P = [A3].CurrentRegion.Offset(1)
    P.Name = "P" 'plage nommée
    ThisWorkbook.Names.Add "debut", 1 'nom défini
    P.Columns(2).Copy P.Columns(3)
    P.Columns(4) = ""
    '---3ème colonne---
    i = Application.Match([A1], F.Rows(5), 0)
    If IsError(i) Then Exit Sub
    P.Columns(3).Replace "~*", 1, xlPart
    For Each c In F.Columns(2).SpecialCells(xlCellTypeConstants)
        If c.Row > 6 Then P.Columns(3).Replace c, IIf(c(1, i - 1) = "", 0, 1)
    Next
End If
If Not flag2 Then
    '---ajoute le code sous la ligne 33 pour remplir la 4ème colonne---
    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
        For i = [debut] To [debut] + [paquet] - 1
            If [debut] = 1 Then .InsertLines 34 + i - [debut], ""
            .ReplaceLine 34 + i - [debut], IIf(Range("P").Cells(i, 3) = "", "", "Range(""" & Range("P").Cells(i, 4).Address(0, 0) & """) = " & Range("P").Cells(i, 3))
        Next
    End With
End If
'---ici ligne 33---
If Not flag2 Then Application.OnTime 1, "Executer" 'lancement différé
End Sub

Private Sub Executer()
flag1 = True: flag2 = True
project_filtering 'lance la macro pour exécuter le code ajouté
flag1 = False: flag2 = False
If [debut] + [paquet] < Range("P").Rows.Count - 1 Then
    ThisWorkbook.Names.Add "debut", [debut] + [paquet]
    flag1 = True
    project_filtering 'lance la macro pour traiter la plage suivante
    flag1 = False
Else
    ThisWorkbook.VBProject.VBComponents("Module1").CodeModule.DeleteLines 34, [paquet] 'supprime les lignes de code ajoutées
    Application.ScreenUpdating = True
    MsgBox Range("P").Rows.Count - 1 & " lignes traitées par paquets de " & [paquet] & vbLf & vbLf & "Durée " & Format(Timer - [t], "0.00 \sec")
End If
End Sub

Chez moi la macro s'exécute en 2,6 secondes.

Notez que des noms définis sont utilisés car quand le VBProject est modifié les variables globales sont réinitialisées.

A+

 

[dysorthographie]

Bonjour,
m'a petite contribution avec une fonction EvaluationCode qui prend en compte directement Applicability!

Sub test()
'(1 OR 0) AND NOT (0 OR 1)
MsgBox EvaluationCode("Banane=1:fraise=0:pomme=0:Groseille=1", "(Banane OR fraise) AND NOT (pomme OR Groseille)")
MsgBox EvaluationCode(Equation:="(1 OR 0) AND NOT (0 OR 1)")
End Sub
Function EvaluationCode(Optional Variable As String, Optional Equation As String)
With CreateObject("ScriptControl")
    .Language = "VbScript"
    .ExecuteStatement Variable & vbCrLf & "V=" & Equation
    EvaluationCode = .Eval("v")
End With
End Function

Option Explicit
Option Compare Text

Public l As Long, col As Integer
Dim Applicability As Variant, sepn As Variant
Dim Besoin As String, TBC As String
Dim cpt As Integer, DIV_Line As Integer
Dim DIV_object As Range, filter_name As Range
Dim DIV As Worksheet, Synthese As Worksheet
Dim PlageDeRecherche As Range

Dim filter As String
Dim dernligne As Integer, derncol As Integer


Sub project_filtering()

Set DIV = Sheets("DIV")
Set PlageDeRecherche = DIV.Columns(2)
Set Synthese = Sheets("Feuil1")
dernligne = Synthese.Range("A65536").End(xlUp).Row


filter = Sheets("Feuil1").Cells(1, 1).Value
'on traite le cas du sans filtre de manière simple puisque pas de filtre = on prends toutes les lignes
Select Case filter
Case Is = "No_Filter"
    For l = 4 To dernligne
    Synthese.Cells(l, 3) = 1
    Next
' on traite le cas des autres filtres
Case Else
Set filter_name = DIV.Rows(5).Find(what:=filter, LookAt:=xlWhole)
col = filter_name.Column


    For l = 4 To dernligne ' on balaye toutes les lignes de la feuille synthèse
        Applicability = Synthese.Cells(l, 2).Value ' on sort l'applicabilité
        ' on traite l'applicabilité pour la convertir en formule binaire
        Select Case Applicability
            Case Is = "*"
            Synthese.Cells(l, 3) = "1"
            Case Else
                sepn = Split(Applicability, " ") 'permet de scinder le commentaire avec le séparateur "espace"
                If UBound(sepn) > -1 Then
                    For cpt = LBound(sepn) To UBound(sepn)
                    sepn(cpt) = Replace(sepn(cpt), "(", "")
                    sepn(cpt) = Replace(sepn(cpt), ")", "")
                    Set DIV_object = PlageDeRecherche.Find(what:=sepn(cpt), LookAt:=xlWhole)
                        If Not DIV_object Is Nothing Then
                        DIV_Line = DIV_object.Row
                            TBC = DIV.Cells(DIV_Line, col).Value
                            Select Case TBC
                            Case Is = "X" 'si c'est applicable on met "1"
                            Applicability = Replace(Applicability, sepn(cpt), 1, , 1)
                            Case Is = "?" 'par defaut on prend en compte les Applicabilités du type "?"
                            Applicability = Replace(Applicability, sepn(cpt), 1, , 1)
                            Case Else 'si c'est non-applicable on met "0"
                            Applicability = Replace(Applicability, sepn(cpt), 0, , 1)
                            End Select
                        End If
                    Next
                End If
        Synthese.Cells(l, 3) = Applicability
        Synthese.Cells(l, "D") = EvaluationCode(Equation:=CStr(Applicability))
        End Select
        Synthese.Columns(3).AutoFit 'ajustement largeur
    Next
End Select

MsgBox ("etape1: done")

' ici je souhaite ensuite rebalayer les lignes en convertissant la forumule binaire précédement calculée en un resultat 0 ou 1
MsgBox ("Le filtre " & filter & " a été appliqué")

End Sub
Function EvaluationCode(Optional Variable As String, Optional Equation As String)
With CreateObject("ScriptControl")
    .Language = "VbScript"
    .ExecuteStatement Variable & vbCrLf & "V=" & Equation
    EvaluationCode = .Eval("v")
End With
End Function

 

[manu_tella]

Bonjour le forum, bonjour job75 et bonjour dysorthographie

Merci pour vos propositions.
@job75 , je suis en train de comprendre ligne à ligne comment fonctionne votre code mais le mode arrêt n'est pas compatible avec les lignes ca me prends un peu plus de temps pour assimiler

@dysorthographie , quand je copie le code j'ai le message suivant:
Run-time error '380': A script engine for the specified language can not be created

j'imagine qu'il y a une référence spécifique à activer mais je n'arrive pas a trouver laquelle.


De mon coté, j'avais commencé à écrire quelque chose de simple du type (en partant du contenu de la colonne 3 est déjà rempli):

Option Explicit

Private dernligne As Integer, l As Integer
Private feuil1 As Worksheet
Private formula As String

Sub req_mac()

Set feuil1 = Sheets("Feuil1")
dernligne = feuil1.Range("C65536").End(xlUp).Row

    For l = 12 To dernligne
    formula = feuil1.Cells(l, 3).Value
             'on integre la formule binaire dans le code de maniere dynamique
             With ThisWorkbook.VBProject.VBComponents("Module3").CodeModule
            .ReplaceLine 19, "feuil1.cells(" & l & ",4) = " & formula
             'ici la ligne de code dynamique qui calcul la formule binaire automatiquement
             End With
' ici s’implémente la ligne dynamique
    Next
End Sub

ça fonctionne bien, le code est dynamique la ligne 19 évolue bien, mais rien ne s’écrit dans la colonne 4....

manu

 

[dysorthographie]

@dysorthographie , quand je copie le code j'ai le message suivant:
Run-time error '380': A script engine for the specified language can not be created

j'imagine qu'il y a une référence spécifique à activer mais je n'arrive pas a trouver laquelle.

non il devrait fonctionner en l'état; à moins que tu sois sur Mac et que tu es omis ce détail!

en tous les cas c'est pas grave, mais vue que tu avais déjà fait tout le travail je trouvais sympa de travailler sur la base de l'équation de la formule binaire que tu avais déjà générée!

 

[manu_tella]

non il devrait fonctionner en l'état; à moins que tu sois sur Mac et que tu es omis ce détail!

en tous les cas c'est pas grave, mais vue que tu avais déjà tout le travail je trouvais sympa de travailler sur la base de l'équation de la formule binaire que tu avais déjà générée!

hello,

non pas sur MAC
je vais essayer de voir pourquoi ce message apparaît.

manu

 

[dysorthographie]

test ça

 

[manu_tella]

Hello

A l'execution du code, la ligne suivante est surlignée:
.Language = "VbScript"

et le message: Run-time error '380': A script engine for the specified language can not be created apparait

manu