InputBox, bouton annuler

P

Philippe

Guest
Bonjour

Grâce à Berbere, j'ai un code top concernant la recherche d'une valeur et la copie des cellules adjacentes.
Il me reste juste un petit pb mineur.
lorsque l'on fait apparaître l'inputbox, si l'utilisateur appuie sur annuler, il y a erreur. Et quelque soit les solutions que j'ai essayé, je bugge à x = InputBox('ma valeur')
D'autre part si la valeur recherchée ne se trouve pas dans la base de donnée, j'aimerais pouvoir faire apparaître un msgbox pour l'informer.

Merci par avance
Philippe

Sub CHERCHEVALEUR()
Dim x As integer, Cel As Range, Tbl As Variant, L As Integer
ReDim Tbl(1 To 3)
With Sheets('Feuil2')
If .Range('A1') = '' Then
L = 1
Else: L = .Range('A1').End(xlUp).Row + 1
End If
End With

x = InputBox('ma valeur')

With Sheets('Feuil1')
For Each Cel In .Range('B1:B' & .Range('B65536').End(xlUp).Row)
If Cel = x Then
Tbl(1) = Cel.Value: Tbl(2) = Cel.Offset(0, 1).Value: Tbl(3) = Cel.Offset(0, 2).Value
With Sheets('Feuil2')
.Range('A' & L & ':C' & L).Value = Tbl
L = L + 1
End With
End If
Next Cel
End With
End Sub
 

CAP

XLDnaute Occasionnel
Pour la msgbox, tu peux faire la simple modification suivante :

Sub CHERCHEVALEUR()
Dim compteur as Integer
Dim x As integer, Cel As Range, Tbl As Variant, L As Integer

compteur = 0 'compteur va vérifier qu'il a trouvé une valeur
ReDim Tbl(1 To 3)
With Sheets('Feuil2')
If .Range('A1') = '' Then
L = 1
Else: L = .Range('A1').End(xlUp).Row + 1
End If
End With

x = InputBox('ma valeur')

With Sheets('Feuil1')
For Each Cel In .Range('B1:B' & .Range('B65536').End(xlUp).Row)
If Cel = x Then
compteur = compteur + 1
Tbl(1) = Cel.Value: Tbl(2) = Cel.Offset(0, 1).Value: Tbl(3) = Cel.Offset(0, 2).Value
With Sheets('Feuil2')
.Range('A' & L & ':C' & L).Value = Tbl
L = L + 1
End With
End If
Next Cel

If compteur = 0 Then
msgbox ('Pas de valeur')
End If

End With

End Sub

En espérant que ça t'aide,
 

Statistiques des forums

Discussions
312 500
Messages
2 089 013
Membres
104 004
dernier inscrit
mista