[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells(1, 1).Address = "$B$1" Then toto
End Sub
Sub toto()
Dim oCel1 As Range, oCel2 As Range, dCel As Range, D As Double, n As Long, tf As Boolean, oMsg As String
With Application: .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: End With
Set dCel = Range("B2").End(xlDown)
If dCel.Row <> Rows.Count Then
Range(Range("D2"), Range("D2").SpecialCells(xlLastCell)).ClearContents
On Error GoTo A
D = Range("B1") ^ 2
On Error GoTo 0
If D Then
For Each oCel1 In Range(Range("B2"), dCel.Offset(-1, 0)).Cells
For Each oCel2 In Range(oCel1.Offset(1, 0), dCel).Cells
On Error GoTo E
If (oCel1.Value - oCel2.Value) ^ 2 + (oCel1.Offset(0, 1).Value - oCel2.Offset(0, 1).Value) ^ 2 <= D Then
On Error GoTo D
oCel1.End(xlToRight).Offset(0, 1).Value = Cells(oCel2.Row, 1).Value
oCel2.End(xlToRight).Offset(0, 1).Value = Cells(oCel1.Row, 1).Value
On Error GoTo 0
n = n + 1
End If
Next oCel2
Next oCel1
End If
End If
S: With Range("D1")
.Value = n
.NumberFormat = IIf(n > 1, "General"" paires""", "General"" paire""")
End With
If tf Then msgbox oMsg
C: With Application: .Calculation = xlAutomatic: .EnableEvents = True: .ScreenUpdating = True: End With
Exit Sub
[COLOR="SeaGreen"]'[/COLOR]
E: msgbox "Données incorrectes :" & vbLf & "(" & Cells(oCel1.Row, 1).Value & ") " & oCel1.Value & " ; " & _
oCel1.Offset(0, 1).Value & vbLf & "(" & Cells(oCel2.Row, 1).Value & ") " & oCel2.Value & " ; " & _
oCel2.Offset(0, 1).Value
On Error GoTo 0
Resume C
[COLOR="SeaGreen"]'[/COLOR]
D: If tf Then Resume Next
tf = True
oMsg = "Toutes les solutions ne sont pas affichées."
Resume Next
[COLOR="SeaGreen"]'[/COLOR]
A: msgbox "Donnée incorrecte en B1."
Resume S
End Sub[/B][/COLOR]