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
| Sub MatchData()
Dim Des, Ter
Dim i As Long, j As Long, k As Long, N As Long, M As Long
Application.ScreenUpdating = False
With Feuil2
N = .Cells(.Rows.Count, 1).End(xlUp).Row
Des = .Range("A3:D" & N)
End With
With Feuil1
M = .Cells(.Rows.Count, 1).End(xlUp).Row
Ter = .Range("A3:E" & M)
End With
'on parcours le tableau Design et pour chaque ligne, on inscrit en colonne 5 la distance avec chaque ligne du tableau terrain
For i = 1 To N - 2
For j = 1 To M - 2
If Ter(j, 5) <> "X" Then
Ter(j, 5) = D(Des, Ter, i, j)
End If
Next j
'k contient le n° de ligne de la distance minimale
k = Mn(Ter)
'on permute les lignes i et k
If k <> i Then Permut Ter, i, k
Next i
'on inscrit le résultat à partir de F4
Feuil3.Range("F3").Resize(M - 2, 4) = Ter
End Sub
'Distance entre ligne s du tableau Tbd et ligne t de tableau Tbt (X en colonne 2 et Y en colonne 3)
Private Function D(ByVal TBd, ByVal Tbt, ByVal s As Long, ByVal t As Long) As Double
D = Sqr(((TBd(s, 2) - Tbt(t, 2)) ^ 2) + ((TBd(s, 3) - Tbt(t, 3)) ^ 2) + ((TBd(s, 4) - Tbt(t, 4)) ^ 2))
End Function
'Donne la ligne où la valeur de la 5ème colonne est minimale
Private Function Mn(ByVal Tb) As Long
Dim i As Long, j As Long
Dim M As Double
M = 9 ^ 9
For i = 1 To UBound(Tb, 1)
If Tb(i, 5) <> "X" Then
If M > Tb(i, 5) Then
M = Tb(i, 5)
j = i
End If
End If
Next i
Mn = j
End Function
'Permute les lignes i et j du tableau Tb
Private Sub Permut(ByRef Tb, ByVal i As Long, ByVal j As Long)
Dim k As Integer
Dim Tmp
For k = 1 To UBound(Tb, 2) - 1
Tmp = Tb(i, k)
Tb(i, k) = Tb(j, k)
Tb(j, k) = Tmp
Next k
'après permutation, on inscrit X dans la colonne 5 du tableau (pour marquage)
Tb(i, UBound(Tb, 2)) = "X"
End Sub |
