Discussion :

[geo86]

Bonjour,

Je souhaite creer une macro "matching data" de facon a faciliter la presentation de 2 jeux de coordonnees en 3 dimensions (X, Y, Z).

Je dispose de coordonnees "design" et de coordonnees "terrain".

Le jeu de coordonnees de reference est "design".

L'objectif est de faire correspondre les coordonnees "terrain" au "design" en respectant l'ordre des points "design".

Conditions:

- la distance entre le point "design" et le point "terrain" est inferieure a 15mm en XY et 20mm en Z au plus pour cet exemple.
- creer un filtre editable sur la distance de maniere a augmenter ou diminuer au besoin la distance minimale de correspondance entre un point "design" et un point "terrain".

Je rappelle la formule pour trouver la distance entre 2 points dans la barre de formule dans la copie d'ecran ci-dessous.

Ci-joint un classeur excel avec un exemple simple pour une macro qui ne l'est pas tant que ca!

[mercatog]

Bonjour
Si tu as un fichier plus complet pour pouvoir tester.

Ci-joint proposition (à adapter) qui a été testée sur ton fichier (sans prendre en compte les Z)

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
Option Explicit
 
Sub MatchData()
Dim Des, Ter
Dim i As Long, j As Long, k As Long, N As Long
 
Application.ScreenUpdating = False
With Feuil1
    Des = .Range("A4:D7")                          'à adapter
    Ter = .Range("A12:E15")                        'à adapter, colonne E pour marquage
    N = UBound(Des, 1)
    '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
        For j = 1 To N
            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
    .Range("F4").Resize(N, 4) = Ter
End With
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))
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

[papouclo]

Bonjour,
Sur le classeur joint, en feuille Sheet2, quelques formules permettent d'automatiser la comparaison des points "design" et des points "terrains".
Cela donne une idée de ce qui pourrait se faire sans VBA
Cordialement
Claude

[geo86]

Si tu as un fichier plus complet pour pouvoir tester.

Ci-joint un fichier plus complet.
A noter que le jeu de coordonnees terrain n'est pas de la meme taille que le jeu de coordonnees design (il est plus grand).

Merci Claude, j'en viens a me demander si ne pas utiliser de macro serait finalement plus facile.
Cependant, modifier le code me semble plus facile que modifier les formules d'excel a chaque fois que les jeux de coordonnees varient de taille.

[mercatog]

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

Merci Claude, j'en viens a me demander si ne pas utiliser de macro serait finalement plus facile.
Cependant, modifier le code me semble plus facile que modifier les formules d'excel a chaque fois que les jeux de coordonnees varient de taille.

Pas du tout, tu peux toujours travailler avec les noms dynamiques de tes plages
Si pour les données terrain, on nomme dynamiquement les 4 colonnes PTT,XT,YT et ZT, le formule devient

Code :

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

=INDEX(PTT;EQUIV(MIN(RACINE((B3-XT)^2+(C3-YT)^2+(D3-ZT)^2));RACINE((B3-XT)^2+(C3-YT)^2+(D3-ZT)^2);0))

PS, pour nommer une plage dynamiquement http://excel.developpez.com/faq/index.php?page=TCD#NommerPlageTCD

PS2: j'ai testé le code et la formule sur ton fichier, ils donnent le même résultat.