Bonsoir à tous,
Merci pour vos aides, mais j'ai un programme que je dois réparer bourré de VLookUp et HLookUp.
Je ne sais pas comment joindre un zip sans déposer une source, et les fichiers déposés sur "ci-joint.fr" ne sont pas accessibles très longtemps.
Evidemment, sans le tableau, le code n'est pas très parlant...
Je le mets quand même, pour commentaires bien venus.
Function Col(LC As Variant) As String
LetCol = Array( _
"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
"AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", _
"BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", _
"CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", _
"DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY", "DZ")
Col = LetCol(LC)
End Function
'=======
Sub Calibre()
Dim i, j
On Error Resume Next
'On retrouve son calibre en fonction du poids entré
If Range("A3").Value >= Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D3:J6"), 1, False) Then
For i = 3 To 6
For j = 2 To 6
xx = 0
yy = 0
xx = Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D" & i & ":J" & i), j, False)
yy = Application.WorksheetFunction.VLookup(Range("A3"), Sheets(1).Range("D" & i & ":J" & i), j + 1, False)
If (Range("B3").Value >xx Or xx "<") And Range("B3").Value < yy Then
Range("C3").Value = Range(Col(j + 2) & "2").Value
Exit For
End If
Next j
If (Range("B3").Value >xx Or xx "X") And Range("B3").Value < yy Then Exit For
Next i
End If
End Sub
'=======
Private Sub Worksheet_Change(ByVal Target As Range)
'Pour tout changement de valeur dans les cellules déverrouillées
If Not Intersect(Target, Range("A3")) Is Nothing Then Calibre
If Not Intersect(Target, Range("B3")) Is Nothing Then Calibre
End Sub
Ce qui est asbolument abominable avec cette fonction, c'est qu'on ne peut pas se passer de "On Error Resume Next" !!! C'est une vraie plaie!!!
Cordialement
Rataxes64