VBA XLTrouver Cellule avec Caractère
Résolu
Roman
-
Zoul67 Messages postés 2001 Statut Membre -
Zoul67 Messages postés 2001 Statut Membre -
Bonjour,
Débutant de chez débutant, depuis quelques jours je n'arrive pas à résoudre ce problème et peut-être quelqu'un d'expérimenté trouvera ?
Je cherche à fabriquer une fonction qui me renvoie l'adresse de la première cellule qu'elle trouve dans une plage donné et qui contient un caractère précis à position précise.
J'ai réussi à rédiger la sub le permettant mais dès que je l'essaie sous forme de function en intoduisant des variables elle buge si le caractère recherché est trouvé à une autre position que celle demandée.
Sub truc()
Dim C As Range
With Worksheets(1).Range("d3:g3")
'object.Find(target, startline, startcol, endline, endcol [, wholeword] [, matchcase] [, patternsearch]) As Boolean
Set C = .Find("d", LookIn:=xlValues)
If Not C Is Nothing Then
firstaddress = C.Address
Do
If Mid(C, 2, 1) = "d" Then MsgBox C.Address: Exit Do
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstaddress
End If
End With
End Sub
'La même que précedent sous forme de fonction
Function RechAdrChaiCar(Pd As Range, A As Variant, Po As Variant) As Variant 'Pl=plage; A=Caractère recherché, Po=position de du caractère
Application.Volatile
Dim Coco As Range
RechAdrChaiCar = 0
With Worksheets(1).Range(Pd.Address)
Set Coco = .Find(A, LookIn:=xlValues)
If Not Coco Is Nothing Then
firstaddress = Coco.Address
Do
If Mid(Coco.Value, Po, 1) <> A Then
.FindNext (Coco)
Else
RechAdrChaiCar = Coco.Address: Exit Do
End If
Loop While Not Coco Is Nothing And Coco.Address <> firstaddress
End If
End With
End Function
Est-ce que quelqu'un pourrait m'aider?
Roman
Débutant de chez débutant, depuis quelques jours je n'arrive pas à résoudre ce problème et peut-être quelqu'un d'expérimenté trouvera ?
Je cherche à fabriquer une fonction qui me renvoie l'adresse de la première cellule qu'elle trouve dans une plage donné et qui contient un caractère précis à position précise.
J'ai réussi à rédiger la sub le permettant mais dès que je l'essaie sous forme de function en intoduisant des variables elle buge si le caractère recherché est trouvé à une autre position que celle demandée.
Sub truc()
Dim C As Range
With Worksheets(1).Range("d3:g3")
'object.Find(target, startline, startcol, endline, endcol [, wholeword] [, matchcase] [, patternsearch]) As Boolean
Set C = .Find("d", LookIn:=xlValues)
If Not C Is Nothing Then
firstaddress = C.Address
Do
If Mid(C, 2, 1) = "d" Then MsgBox C.Address: Exit Do
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstaddress
End If
End With
End Sub
'La même que précedent sous forme de fonction
Function RechAdrChaiCar(Pd As Range, A As Variant, Po As Variant) As Variant 'Pl=plage; A=Caractère recherché, Po=position de du caractère
Application.Volatile
Dim Coco As Range
RechAdrChaiCar = 0
With Worksheets(1).Range(Pd.Address)
Set Coco = .Find(A, LookIn:=xlValues)
If Not Coco Is Nothing Then
firstaddress = Coco.Address
Do
If Mid(Coco.Value, Po, 1) <> A Then
.FindNext (Coco)
Else
RechAdrChaiCar = Coco.Address: Exit Do
End If
Loop While Not Coco Is Nothing And Coco.Address <> firstaddress
End If
End With
End Function
Est-ce que quelqu'un pourrait m'aider?
Roman
1 réponse
-
Salut,
Ce serait pas dû au fait que Po peut être supérieur à la longueur de la chaîne de caractères Coco.Value ?
Fais au moins un test sur la longueur avec Len.
Utilise éventuellement InStr. Evite les .Find et .FindNext en privilégiant une boucle for passant sur toutes les cellules de la plage.
A+-
Salut Zoul67,
Merci beaucoup pour ces conseils, ça marche et c'est le bonheur!
La longueur de la chaine n'est pas en question du coup pas besoin de faire le test avec Len.
Mais j'ai remplacé Mid par InStr et la combinaison de Find, FindNext et Do...Loop par For...Next, comme suit :
Function RechAdrChaiCar(Pd As Range, A As Variant, Po As Long) As Variant 'Pl=plage; A=Caractère recherché, Po=position de du caractère
Application.Volatile
Dim laPlage As Range
Dim Acel As Range
RechAdrChaiCar = 0
Set laPlage = Worksheets(1).Range(Pd.Address)
For Each Acel In laPlage
If InStr(Po, Acel, A, vbTextCompare) = Po Then
RechAdrChaiCar = Acel.Address
Exit Function
Else
RechAdrChaiCar = "nixda"
End If
Next
End Function
Merci encore!
Roman -
-
