Fonction pour connaitre les différences entre 2 strings

Version imprimable

Il n'existe apparemment pas de fonction embarquée qui mette en évidence les différence entre deux Chaine de caractère. Par exemple:
Str1="Quel beau string, c'est un ficelle."
Str2="Quel beau string, mais c'est un tanga."
donnerai comme résultat:
Resultat: "Quel beau string, mais c'est un tanga."
Pensez vous que c'est possible? J4ai commencé à faire une comparaison caractère par caractère mais quand il y a plus d'une différence mon système pour mettre en bold ne fonctionnera pas avec ce système...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ActiveCell.FormulaR1C1 = "Ceci est un test de couleur" With ActiveCell.Characters(Start:=1, Length:=12).Font .Name = "Calibri" .FontStyle = "Normal" .Size = 11 .ThemeColor = xlThemeColorLight1 End With With ActiveCell.Characters(Start:=13, Length:=4).Font .FontStyle = "Gras" .Color = -16711681 End With With ActiveCell.Characters(Start:=17, Length:=11).Font .Name = "Calibri" .FontStyle = "Normal" .Size = 11 .ThemeColor = xlThemeColorLight1 End With
Je sais donc comment colorer mes différence, j'ai plus de problème pour savoir comment logger toutes mes coordonnées start et length de chaque erreur...

Quelqu'un a une idée?
D'avance merci :)

19/02/2013, 17h31
Philippe Tulliez

Bonjour,
Je pense que pour ce cas concret, tu devrais te diriger vers les expressions régulières.
A lire ce tutoriel Les Expressions Rationnelles appliquées en VBA Access et celui-ci Les expressions régulières et .NET

Une autre proposition (gymnastique)

Code qui permet formater la cellule v de telle sorte que les mots n'existant pas dans la cellule c sont en rouge gras

(Dans l'exemple je traite la cellule A2 par rapport à la cellule A1 de Feuil1)

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
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Sub Traiter()
 
With Worksheets("Feuil1")
    Formater .Range("A1"), .Range("A2")
End With
End Sub
 
Private Sub Formater(ByVal c As Range, ByVal v As Range)
Dim i As Integer
Dim Tb
 
With v.Font
    .Bold = True
    .Color = 255
End With
 
Tb = Commun(c.Value, v.Value)
 
If IsArray(Tb) Then
    For i = 1 To UBound(Tb, 2)
        With v.Characters(Start:=Tb(1, i), Length:=Tb(2, i)).Font
            .Bold = False
            .Color = 0
        End With
    Next i
End If
End Sub
 
Private Function Commun(ByVal Str1 As String, ByVal Str2 As String) As Variant
Dim i As Integer, k As Integer, n As Integer
Dim Res() As Integer
Dim Tb
 
If Len(Str1) > 0 And Len(Str2) > 0 Then
    Tb = Split(Str1)
    Str2 = " " & Str2 & " "
    ReDim Res(1 To 2, 0 To 0)
    For i = 0 To UBound(Tb)
        n = 1
        Do
            n = InStr(n + Res(2, k), Str2, " " & Tb(i) & " ", vbTextCompare)
            If n > 0 Then
                k = k + 1
                ReDim Preserve Res(1 To 2, 0 To k)
                Res(1, k) = n
                Res(2, k) = Len(Tb(i)) + 1
            End If
        Loop While n <> 0
    Next i
    Commun = Res
End If
End Function

20/02/2013, 14h24
CaraLePoke

Merci à tout les deux, je teste ça et je fais un retour. :)

Alors pour les expressions Régulières/Rationnelles je n'y suis pas encore... Mais je vais persévérer pour savoir comment les utiliser à l'avenir.
J'ai fait quelque tests avec le code de Mercatog, mais je me heurte à un problème que je ne maîtrise pas... la routine Formater fonctionne avec des Ranges, mais ce sont des cellules que j'utilise (des cellules sauvées dans des variables). Il s'agit d'une comparaison entre deux fichiers et du coup je sauve chaque cellule dans des variables (cellancien et cell recent) avant de les comparer. Voila mon bout de code ou j'insère formater:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 For i = 2 To LigneFin For J = 1 To Colfin Workbooks(AncienFichier).Activate cellancien = Cells(i, J) Workbooks(RecentFichier).Activate cellrecent = Cells(i, J) If cellrecent <> cellancien Then Cells(i, J).Select With Selection.Interior .Color = 255 End With Formater cellancien, cellrecent End If Next Next
Erreur d'execution '424': Objet requis

Je m'en doutais en lui donnant des cellules au lieu de ranges :D
Je vais peut être refaire avec des cells au lieu des range, mais peut être y-a-t-il un autre moyen?

20/02/2013, 15h49
Philippe Tulliez

Bonjour,
La procédure de Mercatog ne pose pas de problème.
Ce sont les Select, Activate et Selection qui sont à proscrire.
[EDIT]
De plus tu ne précises pas la feuille où se trouve les cellules.
20/02/2013, 15h57
CaraLePoke

comment ça proscrire les select/activate? on passe comment d'un workbook à un autre sans ça?

pas besoin de spécifier la feuille, les workbooks en comparaison n'en n'ont qu'une et n'en auront jamais d'autres.

Si il y a un moyen plus propre de coder ça, je suis preneur. :)

Bonjour,

Citation:

comment ça proscrire les select/activate? on passe comment d'un workbook à un autre sans ça?

C'est répété plusieurs fois par semaine sur ce forum
Voilà un exemple. Ici le classeur ancien est le même que le nouveau, il y a donc lieu de l'adapter. LigneFin et ColFin devraient aussi être calculé automatiquement, c'est donc aussi éventuellement à adapter.

Citation:

pas besoin de spécifier la feuille, les workbooks en comparaison n'en n'ont qu'une et n'en auront jamais d'autres.

Je te conseille tout de même de le préciser, c'est une bonne habitude à prendre.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Option Explicit Sub t() Application.ScreenUpdating = False Dim row As Long, col As Integer, LigneFin As Long, ColFin As Integer: Dim wkbOld As Workbook, shtOld As Worksheet Dim wkbNew As Workbook, shtNew As Worksheet Set wkbOld = ThisWorkbook: Set wkbNew = ThisWorkbook Set shtOld = wkbOld.Worksheets("Ancien") Set shtNew = wkbNew.Worksheets("Nouveau") LigneFin = 10: ColFin = 2 For row = 2 To LigneFin For col = 1 To ColFin Formater shtOld.Cells(row, col), shtNew.Cells(row, col) Next Next Application.ScreenUpdating = True End Sub
[EDIT]
Si tu as beaucoup de lignes, je te conseille d'ajouter en début de procédure

Code:

Application.ScreenUpdating = False

et en fin de procédure, même si ce n'est pas obligatoire remettre la valeur à True Je l'ai rajouté (en bleu dans le code)

heu

bonjour

sinon pour comparer deux string il y a les dictionnaires et aussi les variables tableau voir les deux comme ceci

exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Base 1
Sub trouve_les_differences()
Dim d, i As Long, e As Long, tablo1, tablo2, texte As String
tablo1 = Split("Quel beau string, c'est un ficelle.", " ")
tablo2 = Split("Quel beau string, mais c'est un tanga.", " ")
Set d = CreateObject("Scripting.Dictionary")
'on ajoute dans le dictionnaire la premiere phrase
For i = 1 To UBound(tablo1)
 d.Item(tablo1(i)) = ""
Next
'on boucle sur tout les morceaux de laphrase n°2 coupée par les espaces
For e = 1 To UBound(tablo2)
If Not d.Exists(tablo2(e)) Then texte = texte & vbCrLf & tablo2(e)
Next e
MsgBox texte
End Sub

aux plaisir