VBA - Extraction de texte => Trouver et Copier

[john222]

Bonjour,

Je voudrais extraire un numéro de département d'un code postal situé entre la ligne 1 et 100 de la colonne A d'une feuille ("tmpsheet") contenant texte et nombre, puis le copier sur une autre feuille nommée "BDD".
Le code postal en question se trouve sur une ligne qui peut varier selon les documents (d'où le besoin de l'instruction de recherche) et dans la cellule il y a le code postal et la ville.

Voici le bout de code qui ne fonctionne pas:

Set strCPost = ThisWorkbook.Sheets("tmpsheet").Find("#####", 1, 1, 100, 1, True, False, True).Value
strCPost = Left(strCPost, 2)
strCPost.Copy Destination:=Sheets("BDD").Cells(lnbligne, 11)

J'imagine que je n'emploie pas la bonne instruction... Déjà parce que j'ai trouvé deux versions de "Find" avec des paramètres différents, à savoir .find(what, searchorder, etc.) qui renvoie (je crois) une valeur, et le .find(target, startline, startcolumn, endline, endcolumn, etc.), utilisé ci-dessous qui renvoie (je crois) du booléen: d'où sans doute le problème. Mais avec la première je n'arrive pas à combiner l'opérateur "Like..."

Si vous pouviez m'aider rapidement ça serait top!!

Merci d'avance

 

[tototiti2008]

Re : VBA - Extraction de texte => Trouver et Copier

Bonjour john222,

Bienvenue sur XLD,

Si vous pouviez m'aider rapidement ça serait top!!

Ce qui serait top, ce serait de savoir :
à quoi ressemblent tes codes postaux et villes dans leur cellule
un petit bout de fichier exemple (sans données confidentielles) accompagné de ton code qui ne fonctionne pas serait l'idéal pour t'aider

 

[BOISGONTIER]

Re : VBA - Extraction de texte => Trouver et Copier

Bonsoir,

Function CodePostal(champ As Range)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "\d{5}"
  For Each c In champ
    Set a = obj.Execute(c)
    If a.Count > 0 Then CodePostal = a(0): Exit Function
  Next c
  CodePostal = ""
End Function

Sub essai()
  tmp = CodePostal(Range("a1:a4"))
  MsgBox tmp
End Sub

JB

 

[john222]

Re : VBA - Extraction de texte => Trouver et Copier

Merci de ton retour.

Pour donner un exemple concret:
Sur ma feuille tmpsheet (dont le contenu vient à changer), toutes les données sont sur la colonne A, mais il y a parfois plus ou moins de contenu, ce qui fait que il y a plus ou moins de lignes selon les cas.

Et voici par exemple l'extrait de la colonne A qui nous intéresse pour un cas donné (c'est-à-dire que parfois il pourra y avoir plus ou moins de lignes, par exemple 2 numéros de téléphone, mais les intitulés et le format restent les mêmes):

Coordonnées

2, boulevard ababa

34200 Ma ville

Tél.: 02.23.40.55.00

Fax: 02.23.40.55.10

 

[BOISGONTIER]

Re : VBA - Extraction de texte => Trouver et Copier

voir pj

Function CodePostal(champ As Range)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "\d{5}\s"
  For Each c In champ
    Set a = obj.Execute(c)
    If a.Count > 0 Then CodePostal = a(0): Exit Function
  Next c
  CodePostal = ""
End Function

Function tph(champ As Range)
  Application.Volatile
  Set obj = CreateObject("vbscript.regexp")
  obj.Pattern = "\d{2}[-/. ]\d{2}[-/. ]\d{2}[-/. ]\d{2}[-/. ]\d{2}"
  For Each c In champ
    Set a = obj.Execute(c)
    If a.Count > 0 Then tph = a(0): Exit Function
  Next c
  tph = ""
End Function

Sub essai()
  tmp = CodePostal(Range("a1:a100"))
  MsgBox tmp
  tmp = tph(Range("a1:a100"))
  MsgBox tmp
End Sub

JB

 

[john222]

Re : VBA - Extraction de texte => Trouver et Copier

Ca m'a pris un peu de temps pour comprendre... Mais merci beaucoup pour ton aide!

J'avais pourtant regardé comment introduire les regexp dans le VBA mais je trouvais que des codes énormes qui demandaient d'activier des composants externes...

J'ai deux questions si tu as la patience suffisante:
Est-ce que [/i]Set obj = CreateObject("vbscript.regexp") est strictement équivalent à Set obj = New RegExp (comme décrit ici)?

Y aurait-il un moyen malgré tout de passer par le "regexp maison" d'Excel? (comme les # pour les chiffres). C'est juste par curiosité, si tu as une idée du concept à utiliser?

Merci encore!

 

[Staple1600]

Re : VBA - Extraction de texte => Trouver et Copier

Bonsoir

john222
Euh? comment dire

Y aurait-il un moyen malgré tout de passer par le "regexp maison" d'Excel?

Il n'y a pas de regexp maison dans Excel d'ou la référence externe à vbscript

 

[john222]

Re : VBA - Extraction de texte => Trouver et Copier

Oui, je me demandais si on pouvait bricoler quelque chose avec les options de format... Mais c'est certainement moins efficace que les codes de Boisgon

Et d'ailleurs voici un exemple qui me pose problème: j'ai une cellule qui a la valeur "Prénom Nom" dans la colonne Nom (P) et j'aimerai que Nom reste dans Nom, mais que Prénom aille dans la colonne Prénom (O), et que l'espace entre les deux soit supprimé. Pour info la variable lnbligne est un compteur qui incrémente la ligne en cours à chaque tour de boucle!

J'ai essayé d'adapter le code de Boisgontier avec l'expression régulière \S*, mais sans succès.
Du coup en regardant un peu sur Internet j'ai bricolé le code suivant, mais cela ne marche pas: dans le test avec le If, il prend la à chaque fois la condition de sortie au lieu d'exécuter mes instructions, même quand il y a bien les valeurs "Nom Prénom" dans la cellule, et donc un espace.

    With Sheets("BDD")
        If InStr(.Cells(lnbligne, 16), " ") <> 0 Then 'vérifie la présence d'un espace dans la cellule
        varTemp = .Cells(lnbligne, 16)
        MsgBox varTemp 'Test pour voir si il trouve quelque chose => Résultat: la variable est vide... 
        .Cells(lnbligne, 15) = Left(varTemp, InStr(varTemp, " ") - 1) 'on extrait la partie à gauche de l'espace
        .Cells(lnbligne, 16) = Right(varTemp, Len(varTemp) - InStr(varTemp, " ") + 1) 'on extrait la partie à droite de l'espace
        End If
    End With
    Set varTemp = Nothing

Auriez-vous une solution à me proposer?