Problèmes espaces pour convertir données (VBA)

[ZiM]

Bonjour, pour mon entreprise, je développe un convertisseur de données afin pouvoir exploiter ces données dans un logiciel excel.

A cause d'un problème technique, je suis obliger d'extraire mes données via un PDF : copier collé via VBA

Sub convert()
OpenPDF "C:\Documents and Settings\Utilisateur\Bureau\MON FICHIER.pdf", 1
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys ("^{a}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("^{c}")
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys ("%{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
Range("A1").Select
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("^{v}")
Application.Wait (Now + TimeValue("0:00:01"))
Sheets("Données PDF").Select
SendKeys ("^{a}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("^{c}")

Mes données sont incorporées en "A1" jusqu'en "A2000" maximum sous forme de :

FR 4400000000 5542 PRINC ESSE 25/01/1999 66 F N 25/01/1999 B 09/03/2009

Mon problème est que je doit passer par une conversion des données afin qu'elles se répartissent en 10 colonnes soit :

N° National / N°Trav / Nom / Né le / Race / Sexe / Cau.En. / Entré le / Cau.So. / Sortie le

Le "Nom" est parfois haché en 1 / 2 voire 3 morceaux (par un espace indésirable) ce qui rend l'exploitation des données impossibles car les colonnes ce décalent. Je précise que parfois il n'y a pas de nom, ou pas de cause ni date de sorties.

Je passe actuellement par une page de transfert pour renvoyer les données afin de les mettre en forme "exploitables". (suppression de lignes blanches ou indésirables).

Actuellement j'ai essayer ceci qui ne fonctionne pas :

Sub supprimerespaces()

    ' on déclare les variables
Dim nbval, val As Variant
    ' on sélectionne la cellule dans laquelle on a mis la petite formule =NBVAL(colonne) qui va nous permettre de savoir combien de données on a dans cette colonne.
nbval = Range("O2")
     ' on fait une boucle sur la totalité des valeurs
For i = 2 To nbval
    ' on prend la valeur de la celulle
    val = Cells(i, 1)
    ' on modifie cette cellule avec la fonction TRIM qui retire les espaces en début et en fin de chaine
    val = Trim(val)
    ' on re-selectionne la même cellule
    Cells(i, 1).Select
    ' on colle la valeur précédemment modifiée
    ActiveCell.Formula = val
    ' et on continue la boucle !

Next i
End Sub

Avez vous des idées afin de contournez mon problème s'il vous plait ?

PS : éventuellement je peu envoyer ma base de données telle qu'elle est copier (infos confidentielles présentes sur le PDF). Et la seule limite est d'obtenir une base de données utilisable proprement ranger. (vba, formules, suppression du nom éclaté qui n'est que purement informatif : celui en rouge)

Merci d'avence de votre contribution ! Renseignements complémentaires ou précisions sur demande !

 

[JNP]

Re : Problèmes espaces pour convertir données (VBA)

Re ,

Je vais essayer de trouver une alerte en cas de double numéro d'animaux !

Suite à nos différents MP, une solution qui tiens compte du double numéro SI ET SEULEMENT SI le double numéro est bien à l'identique ...

Sub Test()
Dim mm, Résultat As String, I As Double, K As Double
K = Range("A" & Rows.Count).End(xlUp).Row
For I = 1 To K
    If Left(Range("A" & I), 2) = "FR" Then
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{3,4} [-A-Za-z _]* \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & I))
            If mm.Count <> 0 Then
                Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                Range("A" & I) = Replace(Range("A" & I), Résultat, "-")
            End If
        End With
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{3,4} \d{3,4} \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & I))
            If mm.Count <> 0 Then
                Résultat = " " & Split(mm(0), " ")(2) & " " & Split(mm(0), " ")(2) & " "
                Range("A" & I) = Replace(Range("A" & I), Résultat, " " & Split(mm(0), " ")(2) & " - ", , 1)
            End If
        End With
    End If
Next I
End Sub

Bon courage