Microsoft 365 InStr, c'est bien, mais trop court ! !

[DenisHen]

Bonjour à la communauté...
Voilà, j'ai un tableau avec des string construit comme :

Tableau(1)="4/12/4"
Tableau(....)="..."
Tableau(6)="4/18/4"
Tableau(....)="..."
Tableau(33)="44.2/16/44.2"
Tableau(44)="44.2/16/4"

Je cherche donc avec un Do While dans mon tableau, du début à la fin, jusq'à trouvé un InStr <> 0, puis je sors.
Mon problème est que si je cherche "44.2/16/4", InStr le trouve en premier dans "44.2/16/44.2" : Tableau(33), alors que j'aimerais le trouver dans Tableau(44).
Ce qui est normal, mais j'aimerais trouver l'exacte chaine, de la bonne longueur. D'où mon sujet, c'est trop court, ou trop long ! !
J'avais pensé à un Mid, mais je n'y arrive pas...
Il faut savoir aussi que la chaine recherchée sera TOUJOURS de la bonne longueur, et je dois trouver l'exacte réplique, bref, les deux chaines doivent être de la même taille...
Et oui, je parle bien ici de double vitrage...
Si quelqu'un a une astuce, un conseil, voir même la solution... Je suis preneur...
Bien à toi la communauté.
Denis...

 

[fanch55]

Hello,
voici ce que je propose en utilisant les expressions régulières :

Intéressant comme proposition, mais pas sans défaut :

 

[patricktoulon]

re: Bonjour à tous
je répète ça ne peut pas être Good!! à 100%
que ce soit avec

1. les expressions régulières(reg expand)
2. le instr
3. le like

la seule proposition valable dans ce contexte est la proposition de @TooFatBoy qui consiste a travailler avec une colonne sup et des listes de validation
sauf que ça ne semble pas convenir à Denis

ma conclusion: revoir la conception de cet applicatif

 

[jurassic pork]

Intéressant comme proposition, mais pas sans défaut :
Regarde la pièce jointe 1199774

Hello fanch55:
cela m'étonnerait qu'il y ait une date dans la colonne C comme tu en as mis une car cela correspond à une description . Si cela devait arriver on pourrait mettre une expression régulière plus restrictive ou ne pas afficher la fenêtre d'avertissement (pas trouvé donc pas traité)

 

[fanch55]

Hello fanch55:
cela m'étonnerait qu'il y ait une date dans la colonne C comme tu en as mis une car cela correspond à une description . Si cela devait arriver on pourrait mettre une expression régulière plus restrictive ou ne pas afficher la fenêtre d'avertissement (pas trouvé donc pas traité)

Ok d'accord sauf que le vitrage est indiqué plus loin ...
Avec le instr type boeuf ( on cherche chaque vitrage dans le texte ), je n'ai pas trouvé la faille ( mais je n'ai pas tout testé ) ....

 

[TooFatBoy]

Je cherche donc avec un Do While dans mon tableau, du début à la fin, jusq'à trouvé un InStr <> 0, puis je sors.
Mon problème est que si je cherche "44.2/16/4", InStr le trouve en premier dans "44.2/16/44.2" : Tableau(33), alors que j'aimerais le trouver dans Tableau(44).
Ce qui est normal, mais j'aimerais trouver l'exacte chaine, de la bonne longueur.

Le problème à résoudre n'est en fait pas tout à fait celui décrit ici.
Si j'ai bien compris, ce qu'il faut c'est chercher chaque dimension du tableau de référence (contenant dimensions et prix) dans le texte d'une cellule et si on trouve la dimension on retourne le prix au m² correspondant.

Je te propose une fonction qui fonctionne à l'envers de ce que je proposais au départ, c'est-à-dire qu'au lieu d'ajouter une espace au début et à la fin de la chaîne recherchée, au contraire je supprime toutes les espaces dans la chaîne dans laquelle la recherche est effectuée.

Ladite fonction :

Function PrixVitrage(Cellule As Range) As Variant
'
Dim Vitrage As Range
Dim Libelle As String

    ' Tri des vitrages dans l'ordre décroissant
    With Range("t_Vitrage").ListObject.Sort
        .SortFields.Clear
        .SortFields.Add _
                Key:=Range("t_Vitrage[Taille]"), _
                SortOn:=xlSortOnValues, _
                Order:=xlDescending, _
                DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' Mise en forme du libellé
    Libelle = Replace(Cellule.Value, " ", "")
    Libelle = Replace(Libelle, ",", ".")

    ' Recherche de chaque vitrage dans le libellé
    PrixVitrage = ""
    For Each Vitrage In Range("t_Vitrage[Taille]")
        If Libelle Like "*" & Vitrage & "*" Then
            PrixVitrage = Vitrage.Offset(0, 1).Value
            Exit For
        End If
    Next

End Function

 

[jurassic pork]

Hello TooFatBoy,
à noter que dans ta fonction le tri prend énormément de temps :

IDnr​	Name​	Count​	Sum of tics​	Percentage​	Time sum​
0​	debut​	1​	80​	0,06%​	8000 ns​
1​	Tri​	1​	134030​	99,19%​	13 ms​
2​	Replace​	1​	377​	0,28%​	38 us​
3​	Like​	1​	638​	0,47%​	64 us​
​	TOTAL​	4​	135125​	100,00%​	14 ms​
​	​	​	​	​	​
​	​	​	Total time recorded:​	14 ms​	​

Total time recorded: 14 ms

Il serait judicieux de ne l'exécuter qu'une seule fois dans une macro séparée.

Ami calmant, J.P

 

[TooFatBoy]

Logiquement le tri ne devrait pas être dans la fonction.

Mais pour que ça fonctionne il faut absolument que le tri soit effectué. Et je ne voyais pas comment être sûr que le tri était fait, à part en faisant le tri en début de fonction.

Il est éventuellement possible d'effectuer le tri à chaque modification du TS, mais ça me semble un peu moins sûr comme système.


Vu qu'on travaille sur un devis, il ne doit pas y avoir 1000 lignes, donc le tri ne m'a pas semblé handicapant. Sur le classeur qui nous a été fourni, avec Excel tournant sur mon PC de plus de quinze ans, ça passe nickel-chrome, je ne perçois aucune latence.

 

[jurassic pork]

Mais pour que ça fonctionne il faut absolument que le tri soit effectué. Et je ne voyais pas comment être sûr que le tri était fait, à part en faisant le tri en début de fonction.

Ce que tu peux faire c'est utiliser une variable globale booleenne. Si elle n'est pas à Vrai tu fais le tri et tu la positionnes à Vrai. Le tri ne serait effectué qu'une seule fois au premier appel de la fonction. Normalement une variable booléenne est à Faux par défaut.

Public TriFait As Boolean
Function PrixVitrage(Cellule As Range) As Variant
'
Dim Vitrage As Range
Dim Libelle As String
    ' Tri des vitrages dans l'ordre décroissant
If Not TriFait Then
    With Range("t_Vitrage").ListObject.Sort
        .SortFields.Clear
        .SortFields.Add _
                Key:=Range("t_Vitrage[Taille]"), _
                SortOn:=xlSortOnValues, _
                Order:=xlDescending, _
                DataOption:=xlSortNormal
         .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    TriFait = True
End If
    ' Mise en forme du libellé
    Libelle = Replace(Cellule.Value, " ", "")
    Libelle = Replace(Libelle, ",", ".")
    ' Recherche de chaque vitrage dans le libellé
    PrixVitrage = ""
    For Each Vitrage In Range("t_Vitrage[Taille]")
        If Libelle Like "*" & Vitrage & "*" Then
            PrixVitrage = Vitrage.offset(0, 1).Value
            Exit For
        End If
    Next
End Function

 

[TooFatBoy]

Tu crois vraiment que l'ajout d'une variable va te garantir que le tri est fait ???

 

[jurassic pork]

Tu crois vraiment que l'ajout d'une variable va te garantir que le tri est fait ???

Le souci c'est si on fait un changement dans le tableau des prix des vitrages sur la feuille Prix. Dans ce cas il faut mettre ce code VBA dans l'événement Activate de la feuille Devis :

Private Sub Worksheet_Activate()
  TriFait = False
  'Debug.Print "TriFait", TriFait
End Sub

Dès que l'on revient sur la feuille Devis et que l'on fait un changement dans un des Textes du devis , la formule correspondante de la ligne appelle la fonction PrixVitrage et le tri est effectué.

 

[TooFatBoy]

Voilà, tu as bien saisi ce que je voulais te faire comprendre dans mon message précédent.

Perso, je crois que je ne l'aurais pas fait comme ça. Mais au moins là ça doit marcher.

 

[DenisHen]

Bonjour à la communauté, et aussi une somme énorme de mercis ! ! !
J'ai bien étudié vos propositions (qui m'en ont appris bien plus que je ne l'aurais cru, j'ai même péché des idées pour d'autres macros !).

Mais malhereusement, je tiens à ce que l'opérateur, le collègue, débutant ou pas, ne doit pas être restreint à trop de règles de saisie. Il tape le vitrage "tel qu'il le sent", et la fonction fera le reste...

N'est-ce pas l'ultime but de la programation ?

Donc, j'ai fini par établir une ligne de pensée, je ne sais pas ce qu'elle vaut, seuls vous avez cette réponse. Mais si on reste sur des calculs qui se mesurent en millisecondes, ça me va amplement.

Voici mon idée (que j'ai testé, qui plante, mais je n'ai aps dis mon dernier mot ;-) et que je vous soumet avant de me creuser la tête, au cas où ce serait inutile.

En gros, j'essai de chercher l'exacte chaine "courte" dans la chaine "longue" et j'utilise Mid pour comparer en même temps les longueurs des deux chaines.

Est-ce une bonne idée ? ? ? Je n'en sais encore rien, mais grace à cette méthode, plus besoin de rajouter des espaces avant ou après, où de les supprimer...

Function VitragePrix(CherchPrix As Range)
    VitragePrix = 0
    TxtSrc = Replace(CherchPrix.Value, ",", ".") 'Car avec Excel, le "point" du pavé numérique peut être une virgule
    TxtSrc = Replace(TxtSrc, " /", "/")
    TxtSrc = Replace(TxtSrc, "/ ", "/")
    TxtSrc = Replace(TxtSrc, "( ", " ")
    TxtSrc = Replace(TxtSrc, " )", " ")
    TxtSrc = Replace(TxtSrc, "(", " ")
    TxtSrc = Replace(TxtSrc, ")", " ")
    TxtSrc = Replace(TxtSrc, vbLf, " ")
    'Je cherche de la colonne contenant le début des vitrages, au cas ou une colonne serait insérée avant...
    Col = 1
    Do While Worksheets("Prix").Cells(1, Col).Value <> "Vitrage"
      Col = Col + 1
    Loop
    'Maintenant que j'ai trouvé le début des vitrages, je fouille la liste des "noms".
    Lign = 2
    Do While Worksheets("Prix").Cells(Lign, Col).Value <> ""
      NbTxtSrc = Len(TxtSrc): NbPrix = Len(Worksheets("Prix").Cells(Lign, Col).Value)
      For LongSrc = 1 To NbTxtSrc - NbPrix
        If Mid(TxtSrc, LongSrc, NbPrix) = Worksheets("Prix").Cells(Lign, Col).Value Then
          VitragePrix = Worksheets("Prix").Cells(Lign, Col + 1).Value
          Exit Do
        End If
      Next
      Lign = Lign + 1
    Loop
End Function

Bien à vous toutes et tous (et encore mercis ! et au pluriel !).
Denis...

 

[laurent950]

Bonsoir @DenisHen

vous pouvez faire un essai avec cela ?

Function VitragePrix(CherchPrix As Range) As Double
    Dim TxtSrc As String
    Dim ws As Worksheet
    Dim colIndex As Integer
    Dim lastRow As Long
    Dim i As Long
    Dim dict As Object
    Dim key As Variant
    Dim value As Variant
    Dim replacements As Variant
    Dim j As Long

    ' Initialisation du dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Référence à la feuille de calcul
    Set ws = Worksheets("Prix")
    
    ' Remplace les caractères problématiques dans la chaîne source
    replacements = Array(",", ".", " /", "/", "/ ", "/", "( ", " ", " )", " ", "(", " ", ")", " ", vbLf, " ")
    TxtSrc = CherchPrix.Value
    For j = LBound(replacements) To UBound(replacements) Step 2
        TxtSrc = Replace(TxtSrc, replacements(j), replacements(j + 1))
    Next j
    
    ' Trouve l'index de la colonne "Vitrage"
    colIndex = 1
    Do While ws.Cells(1, colIndex).Value <> "Vitrage"
        colIndex = colIndex + 1
    Loop
    
    ' Détermine la dernière ligne de données dans la colonne "Vitrage"
    lastRow = ws.Cells(ws.Rows.Count, colIndex).End(xlUp).Row
    
    ' Charge les données dans le dictionnaire
    For i = 2 To lastRow
        key = ws.Cells(i, colIndex).Value
        value = ws.Cells(i, colIndex + 1).Value
        dict(key) = value
    Next i
    
    ' Recherche dans le dictionnaire
    For Each key In dict.Keys
        If InStr(1, TxtSrc, key, vbTextCompare) > 0 Then
            VitragePrix = dict(key)
            Exit Function
        End If
    Next key
    
    ' Si aucun vitrage trouvé, retourne 0
    VitragePrix = 0
End Function

 

[vgendron]

Bonjour
perso, j'ai décroché du fil il y a un moment..
juste une question: que se passe t il si le collègue saisit un vitrage qui n'existe pas ?
le but ultime, du moins UN but de la programmation est aussi de controler une saisie pour éviter des erreurs..

 

[DenisHen]

Bonjour à la communauté.
Un grand merci @laurent950 : je vais regardé ce code avec grand soins.
@vgendron : j'étudirais ce problème dans un second temps, mais si le vitrage n'existe pas, je pense écrire dans la cellule "Pas de prix !" ou générer une erreur... Je ne sais pas encore... Mais la question est judicieuse...