Extraire des informations dans une chaine de caractère

Bonjour,

Je viens vers vous afin de savoir si vous pouvez me venir en aide concernant l'extraction d'informations d'une chaine de caractère. je souhaite extraire les noms des repères (en rouge) sur toutes les lignes. La fonction d'extraction devra être basé sur le mot repère, va me récupérer les éléments après le mot Repere.

N'hésitez pas à me commenter le code afin que je puisse apprendre la technique.

Je vous remercie d'avance, en vous souhaitant une très agréable journée.

Cordialement,

Nico

Bonjour,

Essaie ça en B11 :

=DROITE(A11;NBCAR(A11)-CHERCHE("repere";A11;1)-6)

la formule renvoie la partie droite de la chaîne de caractère du nombre de caractères de la chaîne moins la position du mot "repere" moins 6 (nb de caractère du mot repere.

J'espère avoir été clair...

Cordialement,

Eric

Bonjour à tous,

Une autre proposition :

Sub Test()

Dim I As Integer, DerniereLigne As Integer
Dim AireATraiter As Range

    With ActiveSheet
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireATraiter = .Range(.Cells(11, 1), .Cells(DerniereLigne, 1))
         AireATraiter.Offset(0, 1).ClearContents
         For I = 1 To AireATraiter.Count
             If InStr(1, AireATraiter(I).Value, "Repere ", vbTextCompare) > 0 Then AireATraiter(I).Offset(0, 1) = Trim(Split(AireATraiter(I).Value, "Repere")(1))
             If InStr(1, AireATraiter(I).Value, "Reperes ", vbTextCompare) > 0 Then AireATraiter(I).Offset(0, 1) = Trim(Split(AireATraiter(I).Value, "Reperes")(1))
         Next I
         Set AireATraiter = Nothing
    End With

End Sub

Merci pour votre retour, en revanche je me retrouve avec une erreur de syntaxe

Bonjour,

Attention qu'il faut utiliser les fonctions anglaises.

cellule = Range("A11")

Resultat = Right(cellule, Len(cellule) - InStr(1, cellule, "repere", vbTextCompare) - 6)

Je reviens vers vous car les deux techniques ne fonctionnent pas. je souhaiterais juste extraire les noms des repères (B1R, B10d...) et les coller en colonne F par exemple. Cette fonction va me servir à isoler des informations contenus dans une chaine de caractère.

Merci d'avance pour vos retour.

Mon code correspond à ce que vous avez demandé dans votre premier message... Sinon, il vous faut spliter le résultat obtenu avec le caractère blanc " ".

J'ai réussi à isoler mon repère, par contre si mon repère contient plus de trois caractères je ne sais pas comment faire.

Voici une proposition

Sub decoupe()

cellule = Range("A12")

debutRepere = InStr(1, cellule, "repere", vbTextCompare)

If (Right(Mid(cellule, debutRepere, 7), 1) = "s") Then
    ' Pluriel
    debutCherche = debutRepere + 8
Else
    ' Singulier
    debutCherche = debutRepere + 7
End If

finCherche = InStr(debutRepere, cellule, "DESSIN")

Resultat = Mid(cellule, debutCherche, finCherche - debutCherche)
If (Left(Resultat, 1) = "") Then
    Resultat = Left(Resultat, Len(Resultat) - 1)
End If

MsgBox Resultat
End Sub

Regarde le fichier joint ci-dessus.

Ca semble marcher sauf quand il y a reperes au pluriel

Bonjour,

Si vous changez les règles en cours de jeu, ce n'est pas l'idéal....

Dans le premier document, vous aviez le terme repere au singulier ou au pluriel et dans la dernière version, ce n'est que du singulier.

Mais je pense que parmi les deux propositions faites, vous avez votre réponse à adapter à vos données finales.

Cdt

Merci beaucoup pour vos retour ! Je vous souhaite une très bonne journée

Avec plaisir.

Salut tout le monde,

Un peu après la guerre, dommage!

Un double-clic sur la première ligne d'infos à extraire démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%
'
If Not Intersect(Target, Columns(1)) Is Nothing Then
    Cancel = True
    iRow = Target.Row
    tTab = Range("A" & iRow & ":F" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For x = 1 To UBound(tTab, 1)
        If InStr(UCase(tTab(x, 1)), "REPERE") > 0 Then _
            sItem = IIf(InStr(UCase(tTab(x, 1)), "REPERES") > 0, "REPERES ", "REPERE "): _
            tTab(x, 6) = Split(Split(UCase(tTab(x, 1)), sItem)(1), " ")(0)
    Next
    Range("A" & iRow).Resize(UBound(tTab, 1), 6).Value = tTab
End If
'
End Sub

A+

Curulis,

Il n'est jamais trop tard pour bien faire !!!!!