Extraire des nombres d'une cellule (Musique pour le Turf)

Bonjour le Forum,

J'aurai souhaité extraire uniquement un nombre pour chaque colonne à partir d'une cellule ou l'on retrouve ce qu'on appelle en jargon Turfiste " La Musique" .

un exemple : On ne retiendra que les 6 1 ères valeurs

on exclura les données suivantes :

J'avais une solution en VBA mais cela plante souvent, je souhaiterai avoir cela en formule, ce sera plus simple je pense.

J'ai essayé avec la fonction substitue mais sur 6 colonnes, je me suis perdu ...

je joins un fichier en exemple,

Si quelqu'un peu m'aider, je l'en remercie.

Cordialement,

Mamarus

Bonjour

Un exemple en vba résultat colonne O si cela te convient tu passes en résolu

Bonjour

Une solution PowerQuery (en add on pour 2010, totalement intégré à partir de 2016)

Actuakliser le tableau résultat quand le source ou le tableau d'exclusions change

Bonjour,

Merci de vous être intéressé à mon sujet, cependant le résultat est incomplet.

Voici la fin de partie des critères :

" Si Da ou Dm ou un 0, on mettra 9 en valeur "

Le résultat du code omet ces conditions Voir exemple ligne 8 :

cela aurait du donner en résultat 6 7 3 9 1 1 ou ne remplace pas le 0 par la valeur 9.

Cordialement,

Mamarus

Salut Mamarus,
Salut les as,

Un double-clic démarre la macro.
Macro valable pour l'exemple uniquement.

tTab = Range("B5").Resize(12, 7).Value
For x = 1 To 12
    iIdx = 0
    sMsg = tTab(x, 1)
    sMsg1 = tTab(x, 1)
    Do Until iIdx = 6
        If InStr(sMsg, "(") > 0 Then _
            sMsg1 = Split(sMsg, "(")(0): _
            sMsg = Split(sMsg, ")")(1)
        If Len(sMsg1) > 1 Then
            For y = 1 To Len(sMsg1) Step 2
                If IsNumeric(Mid(sMsg1, y, 1)) = True Then iNum = IIf(Val(Mid(sMsg1, y, 1)) > 0, Mid(sMsg1, y, 1), 9)
                If Mid(sMsg1, y, 2) = "Da" Or Mid(sMsg1, y, 2) = "Dm" Then iNum = 9
                iIdx = iIdx + 1
                tTab(x, 1 + iIdx) = iNum
                If iIdx = 6 Then Exit For
            Next
        End If
        sMsg1 = sMsg
    Loop
Next
Range("B5").Resize(12, 7).Value = tTab

A+

Bonjour 78chris,

Idem, il manque les conditions Da, Dm ou le 0 qui quand ils sont rencontrés prennent la valeur 9.

Je cherchai une solution par une formule.

Merci quand même ,

Cordialement,

Mamarus

RE

Une formule 2010 ferait 4 kms de long... avec une foultitude de SUSBTITUE imbriqués et plus difficilement évolutive

Bonsoir à tous,

Tu peux réaliser l'épurage des chaines puis l'extraction de leurs chiffres à l'aide d'un regex.

Option Explicit
Sub NettoyerEtExtraire()
    Dim r As Range, rng As Range, i As Byte, str As String
    Dim regex As Object, matches As Object, match As Object
    Application.ScreenUpdating = False

    With Sheets("Feuil1")
        ' Définition de la plage de données en colonne B
        Set rng = .Range("B5", .Range("B" & .Rows.Count).End(xlUp))

        ' Création de l'objet RegExp
        Set regex = CreateObject("VBScript.RegExp")
        regex.Global = True

        ' Parcours des cellules en colonne B
        For Each r In rng
            str = r.Value

            ' Suppression des chaînes "(24)" et "(25)"
            regex.Pattern = "\((24|25)\)"
            str = regex.Replace(str, "")

            ' Remplacement de "Dm" par "9a"
            regex.Pattern = "Dm"
            str = regex.Replace(str, "9a")

            ' Remplacement de "Da" par "9a"
            regex.Pattern = "Da"
            str = regex.Replace(str, "9a")

            ' Remplacement du chiffre "0" par "9"
            regex.Pattern = "0"
            str = regex.Replace(str, "9")

            ' ---- Extraction des chiffres ----
            ' Nettoyage des anciennes valeurs
            r.Offset(0, 1).Resize(1, 10).ClearContents

            ' Définition du pattern pour extraire les chiffres
            regex.Pattern = "\d" ' Capture uniquement les chiffres
            Set matches = regex.Execute(str)

            ' Insérer chaque chiffre dans une cellule adjacente (C, D, E, F...)
            i = 1 ' Colonne C
            For Each match In matches
                r.Offset(0, i).Value = match.Value
                i = i + 1
            Next
        Next
    End With

    Application.ScreenUpdating = True
    MsgBox "Traitement et extraction terminés !", vbInformation
End Sub

Pour obtenir ceci :

klin89

Bonjour à Tous,

Je vous remercie de vous être intéressé à mon sujet.

J'ai réussi à trouver la solution à ce problème.

Bien cordialement,

Mamarus