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
| Sub ValRapp()
Dim i As Long, LastLig As Long, iRow As Long
Dim TabX, TabY, TabEc() As Double
Dim Xo As Double, Yo As Double, Minima As Double
With Sheets("Feuil1") 'à adapter
.Cells.Interior.ColorIndex = xlNone
Xo = .Range("F1").Value 'Xo en F1 à adapter
Yo = .Range("F2").Value 'Yo en F2 à adapter
LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
TabX = Application.Transpose(.Range("A2:A" & LastLig)) 'les X en colonne A
TabY = Application.Transpose(.Range("B2:B" & LastLig)) 'les Y en colonne B
ReDim TabEc(1 To LastLig - 1)
For i = 1 To LastLig - 1
TabEc(i) = (TabX(i) - Xo) ^ 2 + (TabY(i) - Yo) ^ 2
Next i
Minima = Application.Min(TabEc)
For i = 1 To LastLig - 1
If Abs(Minima - TabEc(i)) < 0.0001 Then Exit For
Next i
iRow = i + 1
.Rows(iRow).Interior.ColorIndex = 3
MsgBox "La ligne répondant au mieux aux critères (" & Xo & ", " & Yo & ") est la ligne: " & iRow
End With
End Sub |
Partager