Discussion :

[CaraLePoke]

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 :

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
    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

[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

[mercatog]

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 :

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
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

[CaraLePoke]

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

[CaraLePoke]

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 :

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

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
Je vais peut être refaire avec des cells au lieu des range, mais peut être y-a-t-il un autre moyen?

[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.

[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.

[Philippe Tulliez]

Bonjour,

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.

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 :

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
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 :

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

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)

[patricktoulon]

bonjour

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

exemple

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
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