Option Explicit
Private demande As Long
Sub travdem()
Dim cellule As Range, plage As Range
Dim nomfeuille1 As String
Dim erreur As Boolean
' pour boucler sur la colonne 1
Dim j1 As Long, i As Long, nb As Long, dl1 As Long, j As Long
Dim colec As New Collection
Dim ecart As Single, val1 As Single, valcherche As Single, ecart1 As Single
Dim valt1 As Single, valt2 As Single
Dim cell1 As String, cell2 As String
nomfeuille1 = "Folha1"
'
Dim reponse As Variant
ecart = 1000000
'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
Do
reponse = Application.InputBox(Prompt:="Veuillez indiquer la valeur", Type:=1, Default:=demande)
Select Case reponse
Case ""
MsgBox "vous n'avez pas fait de saisies!" & Chr(13) & "recommencez!", vbCritical, ""
Case False
Exit Sub
Case Else
Exit Do
End Select
Loop
valcherche = reponse
With Sheets(ActiveSheet.Name)
For i = 2 To 8 ' colonne
dl1 = .Cells(Columns(i).Cells.Count, i).End(xlUp).Row
Set plage = .Range(Cells(2, i), Cells(dl1 - 1, i))
For Each cellule In plage
For j1 = cellule.Row + 1 To dl1
j = j1 - cellule.Row
On Error GoTo suite
colec.Add Item:=cellule.Value + cellule.Offset(j, 0).Value, key:=CStr(cellule.Value + cellule.Offset(j, 0).Value)
On Error GoTo 0
If erreur = False Then
val1 = cellule.Value + cellule.Offset(j, 0).Value
If val1 > valcherche Then
ecart1 = val1 - valcherche
Else
ecart1 = valcherche - val1
End If
If ecart1 < ecart Then
valt1 = cellule.Value
valt2 = cellule.Offset(j, 0)
cell1 = cellule.Address
cell2 = cellule.Offset(j, 0).Address
ecart = ecart1
End If
End If
Next j1
Next cellule
Next i
Call MsgBox("Valeur : " & valt1 & " " _
& vbCrLf & "cellule : " & cell1 _
& vbCrLf & "valeur : " & valt2 _
& vbCrLf & "cellule : " & cell2 _
& vbCrLf & "valeur cherché " & valcherche _
& vbCrLf & "Total trouvé " & valt1 + valt2 _
& vbCrLf & "écart " & ecart _
, vbExclamation, "Valeur trouvée")
'.Range("a11") = valt1
'.Range("a12") = valt2
End With
Exit Sub
suite:
erreur = True
Resume Next
End Sub
