Discussion :

[belo75]

Bonjour,
je cherche a compter le nombre de lettres en + et en - et s'il y a une inversion des lettres.
J'ai trouvé la macro ci-joint (algorithme de Damerau-Levenshtein) elle marche très bien et elle donne ce que je veux. Je veux l'adapter a mes variable sauf que je suis nul en VBa et en algorithme.

Mes variable :
var1 que je dois comparer à var11
var2 que je dois comparer à var22
var3 que je dois comparer à var33
var4 que je dois comparer à var44

je ne sais pas l'adapter si vous pouvez m'aider svp ?

Si cette macro fait plus de ce que je souhaite faire on supprime les partie en +

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Public Function WeightedDL(source As String, target As String) As Double
 
    Dim deleteCost As Double
    Dim insertCost As Double
    Dim replaceCost As Double
    Dim swapCost As Double
 
    deleteCost = 1
    insertCost = 1
    replaceCost = 1
    swapCost = 1
 
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
 
    If Len(source) = 0 Then
        WeightedDL = Len(target) * insertCost
        Exit Function
    End If
 
    If Len(target) = 0 Then
        WeightedDL = Len(source) * deleteCost
        Exit Function
    End If
 
    Dim table() As Double
    ReDim table(Len(source), Len(target))
 
    Dim sourceIndexByCharacter() As Variant
    ReDim sourceIndexByCharacter(0 To 1, 0 To Len(source) - 1) As Variant
 
    If Left(source, 1) <> Left(target, 1) Then
        table(0, 0) = Application.Min(replaceCost, (deleteCost + insertCost))
    End If
 
    sourceIndexByCharacter(0, 0) = Left(source, 1)
    sourceIndexByCharacter(1, 0) = 0
 
    Dim deleteDistance As Double
    Dim insertDistance As Double
    Dim matchDistance As Double
 
    For i = 1 To Len(source) - 1
 
        deleteDistance = table(i - 1, 0) + deleteCost
        insertDistance = ((i + 1) * deleteCost) + insertCost
 
        If Mid(source, i + 1, 1) = Left(target, 1) Then
            matchDistance = (i * deleteCost) + 0
        Else
            matchDistance = (i * deleteCost) + replaceCost
        End If
 
        table(i, 0) = Application.Min(Application.Min(deleteDistance, insertDistance), matchDistance)
    Next
 
    For j = 1 To Len(target) - 1
 
        deleteDistance = table(0, j - 1) + insertCost
        insertDistance = ((j + 1) * insertCost) + deleteCost
 
        If Left(source, 1) = Mid(target, j + 1, 1) Then
            matchDistance = (j * insertCost) + 0
        Else
            matchDistance = (j * insertCost) + replaceCost
        End If
 
        table(0, j) = Application.Min(Application.Min(deleteDistance, insertDistance), matchDistance)
    Next
 
    For i = 1 To Len(source) - 1
 
        Dim maxSourceLetterMatchIndex As Integer
 
        If Mid(source, i + 1, 1) = Left(target, 1) Then
            maxSourceLetterMatchIndex = 0
        Else
            maxSourceLetterMatchIndex = -1
        End If
 
        For j = 1 To Len(target) - 1
 
            Dim candidateSwapIndex As Integer
            candidateSwapIndex = -1
 
            For k = 0 To UBound(sourceIndexByCharacter, 2)
                If sourceIndexByCharacter(0, k) = Mid(target, j + 1, 1) Then candidateSwapIndex = sourceIndexByCharacter(1, k)
            Next
 
            Dim jSwap As Integer
            jSwap = maxSourceLetterMatchIndex
 
            deleteDistance = table(i - 1, j) + deleteCost
            insertDistance = table(i, j - 1) + insertCost
            matchDistance = table(i - 1, j - 1)
 
            If Mid(source, i + 1, 1) <> Mid(target, j + 1, 1) Then
                matchDistance = matchDistance + replaceCost
            Else
                maxSourceLetterMatchIndex = j
            End If
 
            Dim swapDistance As Double
 
            If candidateSwapIndex <> -1 And jSwap <> -1 Then
 
                Dim iSwap As Integer
                iSwap = candidateSwapIndex
 
                Dim preSwapCost
                If iSwap = 0 And jSwap = 0 Then
                    preSwapCost = 0
                Else
                    preSwapCost = table(Application.Max(0, iSwap - 1), Application.Max(0, jSwap - 1))
                End If
 
                swapDistance = preSwapCost + ((i - iSwap - 1) * deleteCost) + ((j - jSwap - 1) * insertCost) + swapCost
 
            Else
                swapDistance = 500
            End If
 
            table(i, j) = Application.Min(Application.Min(Application.Min(deleteDistance, insertDistance), matchDistance), swapDistance)
 
        Next
 
        sourceIndexByCharacter(0, i) = Mid(source, i + 1, 1)
        sourceIndexByCharacter(1, i) = i
 
    Next
 
    WeightedDL = table(Len(source) - 1, Len(target) - 1)
 
End Function

[Menhir]

Je veux l'adapter a mes variable sauf que je suis nul en VBa et en algorithme.

Mes variable :
var1 que je dois comparer à var11
var2 que je dois comparer à var22
var3 que je dois comparer à var33
var4 que je dois comparer à var44

Code :

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

1
2
3
4
5
6
Sub Comp4()
   MsgBox WeightedDL(var1, var11)
   MsgBox WeightedDL(var2, var22)
   MsgBox WeightedDL(var3, var33)
   MsgBox WeightedDL(var4, var44)
End Sub