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

ZiM

XLDnaute Nouveau
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 :

Code:
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

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

Bonjour ZiM et bienvenue, salut Banzai64 :),
C'est vrai que ça manque un peu d'exemples pour vérifier :mad:...
Sous réserve que le nom ne contienne que des caractères, et qu'en cas d'absence, il y ait 2 espaces ce qui serait logique vu le séparateur, que le N° travail fasse toujours 4 chiffres et que le format de date ne change pas :rolleyes:...
Code:
Sub Test()
Dim mm, Résultat As String, I As Double
For I = 1 To 50
    If Range("A" & I) <> "" Then
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{4} [A-Za-z _]* \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & I))
            If Len(mm(0)) = 18 Then
                Range("A" & I) = Replace(Range("A" & I), "  ", " _ ")
            Else
                Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                Range("A" & I) = Replace(Range("A" & I), Résultat, Replace(Résultat, " ", "_"))
            End If
        End With
    End If
Next I
End Sub
fonctionne chez moi en remplaçant les espaces par des tirets 8 et en mettant un tiret 8 entre les 2 espaces en cas d'absence du nom.
Sinon, évidement, ça plante :p...
Bonne journée :cool:
 

ZiM

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

Pas de problème !

Voici mon fichier "convertisseur". La première page intègre automatiquement les données via un copier collé VB. La seconde les met en forme (enfin ça c'est l'objectif ^^) pour être exploitable par un autre classeur excel.

J'y ai incorporer quelques données dont les 2 premières fonctionnent très bien tendis-que les suivantes me pauses problème.

Ce lien n'existe plus
 

JNP

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

Re :),
Je vais regarder ton fichier :rolleyes:...
En attendant, dans le cas où il y aurait qu'un espace à la place du nom, sous réserve que les N° devant font toujours le même nombre de caractère, une autre version
Code:
Sub Test()
Dim mm, Résultat As String, I As Double
For I = 1 To 50
    If Range("A" & I) <> "" Then
        With CreateObject("vbscript.regexp")
            .Global = False: .IgnoreCase = True: .Pattern = " \d{4} [A-Za-z _]* \d\d/\d\d/\d{4} "
            Set mm = .Execute(Range("A" & I))
            If mm.Count = 0 Then
                Range("A" & I) = Left(Range("A" & I), 19) & "_" & Right(Range("A" & I), Len(Range("A" & I)) - 18)
            Else
                If Len(mm(0)) = 18 Then
                    Range("A" & I) = Replace(Range("A" & I), "  ", " _ ")
                Else
                    Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                    Range("A" & I) = Replace(Range("A" & I), Résultat, Replace(Résultat, " ", "_"))
                End If
            End If
        End With
    End If
Next I
End Sub
Bon courage :cool:
 

JNP

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

Re :),
Donc en modifiant juste le Pattern pour intégrer le tiret 6
Code:
" \d{4} [-A-Za-z _]* \d\d/\d\d/\d{4} "
mon code fonctionne sur tes 4 exemples.
Bon courage :cool:
 

ZiM

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

Avec le fichier joint ça peut aider ^^

Précisions, le nombre de lignes à traitées est variable selon le cheptel (et oui on parle de vaches). Quand au numéro de travail malheureusement, il peut arriver dans de rare cas qu'il ne soit composé que de 3 chiffres !

Ta commande bug ici :

Range("A" & I) = Left(Range("A" & I), 19) & "_" & Right(Range("A" & I), Len(Range("A" & I)) - 18)

Merci du coup de main ^^
 

JNP

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

Re :),
Avec le fichier joint ça peut aider ^^
Oui, mais il n'y a que 4 lignes :rolleyes:... Difficile d'être exhaustif :eek:...
Précisions, le nombre de lignes à traitées est variable selon le cheptel (et oui on parle de vaches).
Code:
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
devrait traiter tout ton import :p.
Quand au numéro de travail malheureusement, il peut arriver dans de rare cas qu'il ne soit composé que de 3 chiffres !
le Pattern modifié ainsi
Code:
" \d{3,4} [-A-Za-z _]* \d\d/\d\d/\d{4} "
devrait accepter les 3 chiffres et les 4 chiffres
Ta commande bug ici :
Oui, mais sur quelle texte dans la cellule :confused: ? Cette ligne ne s'éxécute que si le motif n'a pas été trouvé, donc qu'il n'existe pas de nom en principe... Aurais-tu des lignes qui ne comprennent pas l'ensemble des données ? A ce moment là, c'est normal que ça beugue si le nombre de caractères est inférieur à 19 :rolleyes:...
Bon courage :cool:
 

ZiM

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

Arf oui mes animaux n'ont pas toujours de nom !

Bon j'ai retirer les coordonnées de mon exemple. Voici un cas complet : (nouvelle feuille)

(ne nombre de sujet n'est jamais le même)


La finalité est d'obtenir une liste comme le second fichier : exempleavant.csv
(comme mon extraction marchait avant en faite)
 

Pièces jointes

  • Nouveau Archive WinRAR ZIP.zip
    13 KB · Affichages: 38
  • Nouveau Archive WinRAR ZIP.zip
    13 KB · Affichages: 32
  • Nouveau Archive WinRAR ZIP.zip
    13 KB · Affichages: 36

JNP

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

Re :),
Testée sur ton dernier fichier
Code:
Sub Test()
Dim mm, Résultat As String, I As Double
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
    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
                Range("A" & I) = Left(Range("A" & I), 19) & "_" & Right(Range("A" & I), Len(Range("A" & I)) - 18)
            Else
                If Len(mm(0)) = 18 Then
                    Range("A" & I) = Replace(Range("A" & I), "  ", " _ ")
                Else
                    Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                    Range("A" & I) = Replace(Range("A" & I), Résultat, Replace(Résultat, " ", "_"))
                End If
            End If
        End With
    End If
Next I
End Sub
après conversion des données donne un taux de réussite de 99,57% avec une seule ligne à corriger à la main : une vache qui porte comme nom son N° de travail :p...
Je ne pense pas arriver à faire mieux :rolleyes:...
Bon courage :cool:
 

ZiM

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

Désolé je tombe sur une erreur à nouveau :

For I = 1 To Range("A" & Rows.Count).End(xlUp).Row

erreur 16 : Expression trop complexe ! Tu ne travail pas sous excel 2010 ? Je suis sous 2007 perso !

Merci si cela fonctionne déjà sauf pour les numéro à la place des noms je vais m'en sortir surtout que je n'ai pas d'espace dans ces cas la !
 

ZiM

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

Bon ca ne fonctionne toujours pas cette méthode ... Plus simple de supprimé cette suite de lettre avec les espaces (car entourée de chiffres). Et les remplacer par un - encadré d'un espace ??? Ca me sert a rien et je vais pas m'en encombrer si les grouper ne marche pas...

Merci de ton aide ;)
 

JNP

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

Re :),
Testé sous 2007, ça, ça marche, mais je ne saurais dire pourquoi :confused:...
Code:
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
                Range("A" & I) = Left(Range("A" & I), 19) & "_" & Right(Range("A" & I), Len(Range("A" & I)) - 18)
            Else
                If Len(mm(0)) = 18 Then
                    Range("A" & I) = Replace(Range("A" & I), "  ", " _ ")
                Else
                    Résultat = Mid(mm(0), 7, Len(mm(0)) - 6 - 12)
                    Range("A" & I) = Replace(Range("A" & I), Résultat, Replace(Résultat, " ", "_"))
                End If
            End If
        End With
    End If
Next I
End Sub
Bon courage :cool:
 

ZiM

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

Génial ca marche super excepter comme promis pour les double numéro d'animaux !

Tu me sort une belle épine du pied ^^ Merci pour avoir plancher malgré les problèmes de compatibilité !

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

Discussions similaires

Réponses
8
Affichages
632

Statistiques des forums

Discussions
312 198
Messages
2 086 107
Membres
103 120
dernier inscrit
83400ren