Récupérer la plus grande chaîne de caractères commune

**Mrfreeze117** · 03/10/2016, 10h29

Bonjours à tous et à toutes,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function Domaine(Description As String)
    Dim cell As Range
    Dim Derli_dom As Long, i As Long
 
    Derli_dom = Feuil9.Columns(1).Find("*", , , , , xlPrevious).Row
 
    For i = 2 To Derli_dom
        If Description Like "*" & Feuil9.Range("A" & i).Value & "*" Then
            Domaine = Feuil9.Range("A" & i).Value
            Exit Function
        End If
    Next
 
End Function

Mon problème est que lors de cette comparaison il prends la première chaîne de caractère commune, je souhaiterai prendre la plus grande.

Par exemple je cherche AAA02 et dans ma table j'ai AAA01, AAA02, AA03,... le résultat ici sera AAA01.

Merci d'avance pour votre aide.

**Marc-L** · 03/10/2016, 10h38

Bonjour,

utiliser la fonction Len renvoyant le nombre de caractères d'une chaîne …

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

**Mrfreeze117** · 03/10/2016, 11h33

Oui mais mon nombre de caractère maximum est variable.

**patricktoulon** · 03/10/2016, 13h21

Bonjour
ben le post commence bien
il y a une erreur dans ton exemple c'est faux en l'occurrence c'est "AAA0"

Par exemple je cherche AAA02 et dans ma table j'ai AAA01, AAA02, AA03,... le résultat ici sera AAA01.

1 question les chiffre qui suivent sont toujours par 01,02,03,04,05 etc...?
2 pareille les lettre c'est toujours des AAAA...?
ta pas un exemple dans les conditions reelles
3 a tu entendu parler des expressions réguliere ??
réponds a ca et puis on verra

**unparia** · 03/10/2016, 13h44

Bonjour à tous ...
En l'occurrence, le mot "commune " étant le mot "commune", ce ne serait même pas "AAA0", mais "AA0", dans l'exemple montré.

Une fois de plus : les mots SONT les mots. Ils sont des éléments d'un lexique verbal, de sorte à ce qu'ils soient compris universellement. Le langage, c'est cela : un vecteur de communication. Lorsque l'un donne "sa" signification à un mot et l' "autre", une autre signification, il n'y a plus de conversation/discussion cohérente possible.

EDIT : je ne serais pas surpris du tout (!!!), bien au contraire, que nous ayons là affaire à un exercice imposé dont l'énoncé lui-même n'a pas été compris, voire analysé.

**patricktoulon** · 03/10/2016, 14h01

re
Bonjour unparia oui c'est vrai tu a raison c'est bien ca
j'était parti sur mon idée et j'ai fait cela
je vais corriger en créant un boucle lettre dans la quelle j'imbriquerait la boucle chiffre de la même manière et le tour est joué
maintenant reste a savoir sil il veut la plus longue ( possible) des plus présentes ou simplement la plus présente encore une fois c'est une histoire d'interprétation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
    Dim chaine As String, dico As Object
    chaine = "AAA01 AA02 ABA06 AAAA05 AAA0154 AAA023 AA01456  AAA0271"
    Set dico = CreateObject("scripting.dictionary")
    For i = 1 To 4: chainevalide chaine, dico, "(\D+)+(\d{" & 2 & "})": Next
    n = 0
    For Each elem In dico
        If dico(elem) > n Then n = dico(elem): chaine = elem
    Next
    MsgBox "la chaine commune la plus longue est " & chaine
End Sub
Function chainevalide(txt As String, dic, matrice, Optional cas = True) As Variant
    Dim Matches, ReG
    Set ReG = CreateObject("VBScript.RegExp")
    With ReG
        .Global = True: .Pattern = matrice: .IgnoreCase = cas
        Set Matches = .Execute(txt)
        ReDim tablo(Matches.Count): i = 0
        Debug.Print Matches(0)
        For Each Match In Matches
            If Not dic.exists(Trim(Match)) Then
                dic(Trim(Match)) = 1
            Else
                dic(Trim(Match)) = dic(Trim(Match)) + 1
            End If
            Debug.Print Trim(Match)
        Next
    End With
 
    Set ReG = Nothing
End Function

**Marc-L** · 03/10/2016, 14h30

Envoyé par Mrfreeze117

Oui mais mon nombre de caractère maximum est variable.

Ben justement avec la fonction Len par comparaison juste en chauffant une paire de neurones ‼

**patricktoulon** · 03/10/2016, 14h48

voila
Marc "len" je veux bien mais tester quoi?? dans une boucle ? beaucoup trop long !!!!
régular fait ca pour nous

surtout que la chaine commune ne commence pas forcement au debut de chaque cells (len,split,mid,etc...=boucle interminable)

avec regular j'ai brider a 4 caractères par valeur(string/numérique)le tout dans un dico et on cherche le plus grand item

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
    Dim chaine As String, dico As Object
    chaine = "AAA123AAA123AAA01AAA123AA02ABA06AAA123AAAA05AAA123AAA0154AAA23AAA123AA01456AAA0271AAA123AAA123AAA123AAA123"
    Set dico = CreateObject("scripting.dictionary")
    For a = 1 To 4
        For i = 1 To 4
            chainevalide chaine, dico, "(\D{" & a & "})+(\d{" & i & "})"
        Next
    Next a
    n = 1
    For Each elem In dico
        If dico(elem) >= n Then n = dico(elem): chaine = elem
        Debug.Print elem & ":::" & dico(elem)
    Next
MsgBox "la chaine commune la plus longue est " & chaine
End Sub
Function chainevalide(txt As String, dic, matrice, Optional cas = True) As Variant
    Dim Matches, ReG
    Set ReG = CreateObject("VBScript.RegExp")
    With ReG
        .Global = True: .Pattern = matrice: .IgnoreCase = cas
        Set Matches = .Execute(txt)
        ReDim tablo(Matches.Count): i = 0
 
        For Each Match In Matches
            If Not dic.exists(Trim(Match)) Then
                dic(Trim(Match)) = 1
            Else
                dic(Trim(Match)) = dic(Trim(Match)) + 1
            End If
            'Debug.Print Trim(Match)
        Next
    End With
    Set ReG = Nothing
End Function

ps: si il faut déterminer les ex éco y a qua demander

re
je ne l'ai pas mis voila chose faite
pour transformer ta colonne en chaine string a examiner c'est comme ceci:
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'récupérer une colonne d'un tableau dans un array a 1 dimention join en string
      with activesheet: tableau = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value:end with
    chaine = Join(Application.Transpose(Application.Index(tableau, , 1)), "")

**Mrfreeze117** · 03/10/2016, 15h43

Envoyé par unparia

Bonjour à tous ...
En l'occurrence, le mot "commune " étant le mot "commune", ce ne serait même pas "AAA0", mais "AA0", dans l'exemple montré.

Une fois de plus : les mots SONT les mots. Ils sont des éléments d'un lexique verbal, de sorte à ce qu'ils soient compris universellement. Le langage, c'est cela : un vecteur de communication. Lorsque l'un donne "sa" signification à un mot et l' "autre", une autre signification, il n'y a plus de conversation/discussion cohérente possible.

EDIT : je ne serais pas surpris du tout (!!!), bien au contraire, que nous ayons là affaire à un exercice imposé dont l'énoncé lui-même n'a pas été compris, voire analysé.

Cela ne pause pas de souci si dans je n'ai pas quelque chose du type AAA011, et dans ma table AAA01, AAA02,..., AAA011. Au quelque cas le résultat au lieux de trouver AAA011 mais AAA01 (car ce sera le premier champ compris dans ma cellule.

J'ai trouvé ça comme solution:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function Domaine(Description As String)
    Dim cell As Range
    Dim Derli_dom As Long, i As Long, cara As Long
 
    Derli_dom = Feuil9.Columns(1).Find("*", , , , , xlPrevious).Row
    cara = 0
    For i = 2 To Derli_dom
        If Description Like "*" & Feuil9.Range("A" & i).Value & "*" Then
            If Len(Feuil9.Range("A" & i).Value) > cara Then
                cara = Len(Feuil9.Range("A" & i).Value)
                Domaine = Feuil9.Range("A" & i).Value
            End If
        End If
    Next
 
End Function

Qu'en pensez-vous?

**patricktoulon** · 03/10/2016, 16h33

heu...d'accords
j'ai l'impression de passer inaperçu moi
a tu regardé au moins mes propositions

tu cherche la variable description dans ta plage et après ????!!!!!! un simple find suffit a faire ca, mais ca ne fait pas ce que tu désire
car pour utiliser ca il faut déjà connaitre la chaine commune ce qui est insensé puisque c'est l'object de ta demande

en gros ta fonction ne sert a rien

edit en plus j'avais pas bien vu la recursivité

comme tu démarre a chaque fois a la même ligne ca te donne le même

**Mrfreeze117** · 03/10/2016, 17h22

Désolé mais je ne comprends rien à ta solution, et si ma fonction rempli parfaitement ce que je cherche à faire. Pour utilisé find il aurai fallu que je cherche quelquechose dans une table la c'est l'inverse je teste chaque ligne de ma table pour savoir si oui ou non la ligne de la table est contenue dans ma cellule. Et pour être sur d'avoir la bonne valeur et pas une autre je test le nombre de caractère.

Après je sais pas si je peux accélérer les choses parce que là j'avoue que c'est un peu long lorsque excel recalcule chaque cellule.

**patricktoulon** · 03/10/2016, 19h04

chez moi ta fonction ne donne rien
d'une part déjà tu n'a pas de retour tout reste dans ta boucle

a quoi bon faire une fonction si elle retourne rien fait une sub
de mon code en l'état tu n'a rien a modifier tu lance et le message te dit la chaine point barre
ca te fera un code a potasser les longue nuit d'hiver

Invité · 03/10/2016, 20h56

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Domaine "aaAA"
End Sub
Function Domaine(Description As String)
    Dim Derli_dom As Long, i As Long
  Derli_dom = Feuil9.Range("A" & Cells.Rows.Count).End(xlUp).Row
 Set RS = RequetXls(Description, Feuil9.Range("A2:A" & Derli_dom).Value)
 With Feuil9
     For i = 2 To Derli_dom
        RS.Filter = "Description Like '%" & .Cells(i, "a") & "%'"
        If RS.EOF = False Then .Cells(i, "a") = RS("Cells")
     Next
 End With
End Function
Function RequetXls(Description As String, R) As Object
Const adDouble = 5
Const adVarChar = 200
Const adDate = 133
 
 
Set objRecordSet = CreateObject("ADODB.Recordset")
objRecordSet.Fields.Append "NBCHAR", adDouble
objRecordSet.Fields.Append "Description", adVarChar, 255
objRecordSet.Fields.Append "Cells", adVarChar, 255
objRecordSet.Open
For i = 1 To UBound(R)
    objRecordSet.AddNew Array("NBCHAR", "Description", "Cells"), Array(Len(R(i, 1)), Description, R(i, 1))
Next
objRecordSet.Sort = "NBCHAR DESC, Cells"
Set RequetXls = objRecordSet
End Function

**unparia** · 04/10/2016, 07h33

1) Les algos ne manquent pas, parmi lesquels :
https://en.wikipedia.org/wiki/Longes...string_problem
http://algorithms.tutorialhorizon.co...mon-substring/
encore faut-il que l'on parle de la même chose (relire ma première remarque, plus haut)
2) si les différentes chaînes ne sont pas de la même longueur, il est astucieux de commencer par la chaîne la plus courte de celles présentes. Pourquoi ?
parce que la chaîne recherchée est au mieux la chaîne la plus courte, puisque les autres sous-chaînes que pourraient contenir d'autres chaines ne sauraient être communes (puisque non dans cette chaîne-là).
Si cette chaîne existe dans toutes les autres chaînes, c'est elle, la plus longue chaîne commune. Si non, on cherche à partir de là seulement (et pas à partir de tout)
Là s'arrête ma participation à cette discussion.

Invité · 04/10/2016, 07h51

Bonjour unparia,
Dans l'exemple donné, le demandeur récupère la le texte le plus long, dès l'instant ou un fragment ce trouve dans la valeur en modèle et ce quelque soit si la Phrase la plus longue existe ou pas dans le modèle!

Et effectivement c'est n'est pas forcément le but recherché!

Mais ma méthode permet de surmonter cette difficulté sans problème!
Vue que la première valeur trouvé sera la bonne mais je dois modifier le filtre dans ce cas la!

Édite:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RS.Filter = "Description Like '%" & .Cells(i, "a") & "%' And  Description Like '%' & Cells &'%'"

Mais il est vrai que on pourrait rechercher un modèle de produits en fonction de ça racine !

**unparia** · 04/10/2016, 07h55

Bonjour ami Robert
J'avais bien vu cela.

D'où mon :

encore faut-il que l'on parle de la même chose (relire ma première remarque, plus haut)

Le titre donné à cette discussion est alors maladroit et plus que "questionnable". Le premier message également.
Amitiés

**Mrfreeze117** · 04/10/2016, 09h37

Pour que l'on parle tous de la même chose voici un exemple en fichier.

dysorthographie: je comprends pas à quoi sert ta fonction :RequetXls

unparia: Désolé si je n'arrive pas me faire comprendre.

Merci pour votre aide

Invité · 04/10/2016, 09h38

c'est pas grave!

mais au-moins tu l'as testé?

RequetXls permet de faire une recherche instantané sans boucle ; ça retourne RS!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RS.Filter = "Description Like '%" & .Cells(i, "a") & "%'"

**Mrfreeze117** · 04/10/2016, 10h19

Je viens de testé, une fois sur deux ça me fait planter Excel et l'autre fois ça met un temps infini à mettre à jour toute mes cellules.

Tu as regardé mon fichier? Ma solution a l'air de fonctionner mais est aussi trop lente ( sur 300 lignes) ça mets environ 15s à s'actualiser.