Extraction de chiffre par VBA

Question

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 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 finallement  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

Answer 1

Bonjour

Je n'ai pas de doc particulière à te recommander.

Comme dans ma première réponse je te disais que c'était surement optimisation.

J'étais resté sur le principe d'une fonction vu que partais de là.

Le VBA est lent comme langage (interprété) et dans ce cas c'est pire car en utilisant une fonction ainsi Excel recherche 10 fois les 10 occurrences et ce pour chaque ligne !

1 millions de lignes = 100 millions de recherches !

Je te propose ceci à tester :

Sub Extraction()

    Dim LigneDeb As Long

    Dim reg As Object

    Dim Resultats As Object

    Dim lg As Long

    Dim i As Byte

    Application.ScreenUpdating = False    

    LigneDeb = Selection.Rows(1).Row

    Set reg = CreateObject("vbscript.regexp")

    reg.Global = True

    reg.Pattern = "\d+.?\d*%"

    For lg = 1 To Selection.Rows.Count

        Set Resultats = reg.Execute(Range("B" & LigneDeb + lg - 1))  'Colonne B

            For i = 1 To Resultats.Count

                 Cells(lg + LigneDeb - 1, i + 2) = Replace(Replace(Resultats.Item(i - 1), ".", ","), "%", "") / 100 '+2 Pour colonne C, +3 pour colonne D....

            Next

    Next

    Set reg = Nothing

   Application.ScreenUpdating = True

End Sub

C'est une procédure, tu sélectionnes les données colonne B (Sélection de la 1ere cellule puis CTRL+MAJ+Flèche Bas) puis tu exécutes la procédure qui va générer les valeurs en colonne C, D,....

C'est plus rapide (10s pour 100 000 lignes).

Answer 2

Voici

Je m'était trompé sue le pattern

\d+.?\d*%

\d =>(1 chiffre)

+  =>(répété 1 ou plusieurs fois)

.    =>(un caractère point)

?   => (répété 0 ou 1 fois)

\d =>(1chiffre)

*   =>(répété 0 ou plusieurs fois)

% =>(un caractère %)

J'ai supprimer le remplacement de la "(" qui était devenu inutile

Function ExtrationPourcentage(Chaine As String, k As Byte) As Single

    Dim reg As Object

    Dim Resultats As Object

    Dim Resultat As String

    Set reg = CreateObject("vbscript.regexp")

    reg.Global = True

    reg.Pattern = "\d+.?\d*%"

    Set Resultats = reg.Execute(Chaine)

    If Resultats.Count <> 0 Then

        Resultat = Replace(Resultats.Item(k - 1), "%", "")

    End If

    ExtrationPourcentage = (Replace(Resultat, ".", ",") / 100)

End Function

Answer 3

Merci pour ce retour,

C'est un plaisir d'aider et cela me permet de maintenir mes compétences et me forcer à travailler des sujets nouveaux.

Arnaud Cottin Consultant-Formateur BCIF

Bon courage pour la suite

Answer 4

Bonjour Arnaud,

MERCI BEAUCOUP POUR VOTRE SUPPORT ET VOTRE AIDE BIEN PRÉCIEUSE. J'APPRÉCIE ÉNORMÉMENT!

Votre solution fonctionne efficacement, d'une façon stable, et très économique en terme de consommation de temps d'opération.

Vous m'avez bien rendu service, et si vous le voulez bien, pourriez me communiquer votre (i) nom, (ii) titre professionnel et (iii) affiliation, car lors de mes écrits de recherche je tiens toujours à mentionner (et remercier) tous les professionnels qui m'aident à extraire, à filtrer, à mettre en forme, ... et à mener, en général, mes projets de recherche. C'est la moindre des choses. Le présent projet sur lequel je travaille actuellement aura des publications à partir de l'année prochaine.

Merci encore Arnaud et au plaisir d'avoir de vos nouvelles.

Cordialement.

Jad