Extraction de pourcentage par VBA

Bonjour,

J'ai des données qui sont structurées en fichier Excel. J'aimerais bien faire l'extraction des pourcentages qui sont dans une de mes colonnes. Je vous donne un exemple du contenu dans ces cellules:

At 31-Dec-2008: Roberto (11.899%) Antonio (23.798%); Maria (11.899%) ; Jose (23.798%) ; Martin (23.798%) , Diego (4.808%)

J'ai trouvé un programme VBA pour l'extraction des pourcentages, qui est comme suit:

Public Function wExtractPercent(sInput) As Double

If IsNumeric(sInput) Then

wExtractPercent = sInput

Else

end_position = InStr(sInput, "%")

For i = end_position To 1 Step -1

If Mid(sInput, i, 1) = " " Then

start_position = i

Exit For

End If

Next

If start_position = 0 Then

wExtractPercent = Left(sInput, end_position - 1) / 100

Else

wExtractPercent = Mid(sInput, start_position, end_position - start_position) / 100

End If

End If

End Function

Ce programme fonctionne bien, mais avec quelques imperfections:

Imperfection 01: Avant d'appliquer la fonction wExtractPercent, il faut nettoyer le contenu de la cellule des parenthèses "(" et ")"

Imperfection 02: Avant d'appliquer la fonction wExtractPercent, il faut remplacer le point du pourcentage "." par ","

Imperfection 03: Le programme ci-dessous, lit juste le premier pourcentage dans le contenu et ignore le reste des pourcentages.

Je vous donne ma démarche actuelle pour l'extraction des pourcentages:

Étape 01: Je convertis ma colonne en plusieurs afin d'obtenir un pourcentage dans chaque colonne et non pas plusieurs;

Étape 02: je remplace les parenthèses "(" et ")" par des espaces " ";

Étape 03: je remplace "." par "," ;

Étape 04: j'applique finalement la fonction wExtractPercent qui me donne le pourcentage qui se trouve dans chaque cellule.

Quatre étape ce n'est pas beaucoup pour quelques cellules, mais le problème c'est que j'ai des centaines de milliers de cellules à traiter, et cela devient fastidieux est aussi lourd pour excel.

Ma question est donc la suivante:

Pourriez-vous m'aider à améliorer mon programme/ma fonction VBA ci-dessus pour faire l'extraction en moins d'étapes et d'une façon plus conviviale.. Cela me rendra grand service.

Merci d'avance

Bonjour et bienvenue,

Merci de joindre un fichier à ta demande avec des exemples de résultats souhaités.

Cdlt.

Bonjour,

Une piste avec la fonction Split() :

Sub Test()

    Dim T
    Dim Chaine As String
    Dim Resultat As String
    Dim I As Integer

    Chaine = "At 31-Dec-2008: Roberto (11.899%) Antonio (23.798%); Maria (11.899%) ; Jose (23.798%) ; Martin (23.798%) , Diego (4.808%)"

    T = Split(Chaine, "(")

    For I = 1 To UBound(T)

        Resultat = Resultat & Split(T(I), ")")(0) & vbCrLf

    Next I

    MsgBox Resultat

End Sub

Bonjour Theze,

D'abord, je vous remercie de prendre le temps pour me répondre. J'apprécie beaucoup.

Toutefois, j'ai essayé d'appliquer les deux codes que vous m'avez fournis...mais sans résultat. Excel me renvoie à chaque fois "#VALEUR!".

J'avoue que mes connaissances en VBA sont vraiment de base. Certes, j'ai beaucoup travaillé avec Excel et ses fonctions, mais je viens de commencer avec VBA (par obligation

Pour faire une histoire courte, j'ai commencé ma recherche de solution à mon problème par le code (celui qui porte sur la fonction wExtractPercent) que j'ai mis dans mon premier message et dont j'ai omis de vous mettre la source, et qui est la suivante:

http://access-excel.tips/extract-percentage-from-text/

Après multiples modifications de la cellule (remplacement des parenthèses et du point...), j'appelle ensuite la fonction wExtractPercent, et la valeur sortie par cette fonction porte toujours sur le premier pourcentage de la cellule.

Donc, s'il vous plait, pourriez-vous soit m'améliorer le code suivant:

Public Function wExtractPercent(sInput) As Double

If IsNumeric(sInput) Then

wExtractPercent = sInput

Else

end_position = InStr(sInput, "%")

For i = end_position To 1 Step -1

If Mid(sInput, i, 1) = " " Then

start_position = i

Exit For

End If

Next

If start_position = 0 Then

wExtractPercent = Left(sInput, end_position - 1) / 100

Else

wExtractPercent = Mid(sInput, start_position, end_position - start_position) / 100

End If

End If

End Function

ou bien modifier votre code, afin que je puisse extraire par une fonction tous les pourcentages qui se trouvent dans la cellule (des pourcentages qui pourraient être séparés par un trait ou un point virgule ou dans différentes cellules...)

Autrement dit, je veux extraire d'une cellule avec un contenu similaire à celui là:

At 31-Dec-2008: Roberto 11.899% ; Nicolas 23 %; Monica (11.899%) ; Luis 23.79% ; Martin (23.798%) ; Diego 4.8%.

Les pourcentages suivants :

0,11899 ; 0,23 ; 0,11899% ; 0,2379 ; 0,23798% ; 0,48

Vous constatez que les pourcentages dans ma banque de données sont parfois entre parenthèses parfois non, parfois en décimal parfois en chiffre rond. J'ai mis dans l'exemple toutes les variantes.

Ces résultats pourraient être dans une seule ou plusieurs cellules. Je dispose d'une banque de plusieurs centaines de milliers de données que je dois traiter et analyser par la suite, et votre aide me rendra grandement service.

Je vous remercie pour votre temps et surtout pour votre expertise.

Re,

Voici un classeur avec des fonctions qui doivent être validées sous formes matricielles (Ctrl+Maj+Entrée). L'une extrait les pourcentages sous forme de String (chaine) et l'autre sous forme de nombre (Double). Je suis parti du postulat que les pourcentages extrait doivent se trouver en ligne :