> Tous les forums > Forum Bureautique
 [Extraction dans cellules]Sujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
Magnan
  Posté le 06/06/2015 @ 08:08 
Aller en bas de la page 
Astucien

Bonjour,

Suite à une absorption des pages jaunes (Avec ANNUCAPT) j'ai un fichier XL que je transférerai dans Access.

Dans une colonne contenant plus de 6.000 cellules j'ai les informations suivantes :

M Dupont Pierre

MME Bidule Jeanne Louise

Dupuis

MME Durand M Duluc

...

En bref :

1)j'ai parfois (le plus souvent) la civilité, parfois non. J'ai commencé à saisir celles qui sont absentes au vu du prénom.

2) Le prénom n'est pas toujours présent, ou il est composé (Séparé ou non par un -).

3) Parfois je n'ai aucune information

4) Dans quelques cas j'ai 2 voire 3 personnes dans la cellule.

Je souhaiterais isoler dans une cellule la civilité et dans une autre le nom et dans une troisième le prénom.

Extraire la civilité (Quand il y a un seul dirigeant) , je sais faire. Mais pour le reste je cale au vu des multiples possibilités.

Auriez vous des idées, lumineuses et simples comme d'habitude...

Merci d'avance.



Modifié par Magnan le 06/06/2015 11:59
Publicité
ferrand
 Posté le 06/06/2015 à 10:55 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Bonjour,

Au vu de ton exemple (et sous réserve de test [en raison de caractères non visibles dont la présence est éventuellement possible], et si c'est bien le caractère 10 [aller à la ligne] qui sépare 2 noms dans la même cellule [c'est normalement le cas dans Excel, mais la source étant externe...]).

Sub Magnan()
Dim i%, n%, k%, c%, drg$, civ
With ActiveSheet
n = Range("B" & .Rows.Count).End(xlUp).Row
civ = Split("M ;MME ;MLE ;MLLE ", ";")
For i = 2 To n
drg = Trim(.Cells(i, 3).Value)
k = 4
Do While drg <> ""
For c = 0 To 3
If drg Like civ(c) & "*" Then
.Cells(i, k).Value = RTrim(civ(c))
drg = Replace(drg, civ(c), "", 1, 1)
Exit For
End If
Next c
k = k + 1
h = InStr(1, drg, " ")
If h > 0 Then
.Cells(i, k).Value = Left(drg, h - 1)
drg = LTrim(Right(drg, Len(drg) - h))
Else
.Cells(i, k).Value = drg
Exit Do
End If
k = k + 1
h = InStr(1, drg, Chr(10))
If h > 0 Then
.Cells(i, k).Value = RTrim(Left(drg, h - 1))
drg = LTrim(Right(drg, Len(drg) - h))
If InStr(1, .Cells(i, k).Value, " ") > 0 _
Then .Cells(i, k).Interior.Color = RGB(0, 255, 255)
Else
.Cells(i, k).Value = drg
If InStr(1, drg, " ") > 0 Then .Cells(i, k).Interior.Color = RGB(0, 255, 255)
Exit Do
End If
k = k + 1
Loop
Next i
End With
End Sub

NB- Le premier nom vient en D, E, F, le suivant en G, H, I, etc.

Les 2 lignes surlignées sont optionnelles, elles colorent la cellule Prénom en jaune lorsqu'il y a indécision et qu'il est bon de vérifier.

On coupe en effet le nom à la première espace (une fois sortie la civilité), or si le nom est en 2 mots incluant une espace, la deuxième partie sera amalgamée au prénom. Le nombre de cas de ce type étant nécessairement limité, il est plus rationnel de vérifier visuellement plutôt que de doubler le volume de code sans pour autant que le résultat soit totalement garanti.

Magnan
 Posté le 06/06/2015 à 11:03 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour,

Prompte à dégainer ;) comme d'habitude.

Merci pour ce code que je vais analyser pour le comprendre et essayer le plus vite possible.

Merci encore.

ferrand
 Posté le 06/06/2015 à 11:34 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

J'ai oublié de déclarer la variable h ! Tu rajoutes : h% dans la ligne Dim....

C'est du "pas à pas", on sort chaque élément l'un après l'autre...

Magnan
 Posté le 06/06/2015 à 11:37 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour,

La honte est sur moi.... en reprenant un fichier pour test j'ai oublié de positionner les colonnes au bon endroit.

Celà fonctionne.

Merci.

Petite remarque : Lorsqu'il y a 2 personnes dans la cellule B, elles sont identifiées séparément mais la première voit sa civilité indiquée en E et non D. Toutes les informations se toruvent alors décalées d'une colonne. Et le nom de famille se trouve alors dans une cellule colorée en bleu.

Mais à la main c'est vite rectifié.

.Effacé par srongneu gneu de tête de linotte....

A+



Modifié par Magnan le 06/06/2015 12:06
ferrand
 Posté le 06/06/2015 à 12:01 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

La mettre dans un module standard.

edit : les modules de feuilles (et ThisWorkbook) sont des modules privés. Seuls les modules standard sont publics. [Pour lancer de l'extérieur une procédure dans l'un de ces modules, il faut qu'elle soit déclarée publique, et l'appel de la procédure inclue le module appelé...]



Modifié par ferrand le 06/06/2015 12:05
ferrand
 Posté le 06/06/2015 à 12:49 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

Tu m'as fait réviser la portée des procédures ! J'allais ajouter qu'on ne devait pas la voir dans la boîte de dialogue Macros si elle se trouvait dans un module de feuille, mais en effet on la voit, précédée du nom de module.

Donc, rectif : ma note concernait les variables, privées par défaut, qui doivent être déclarées publiques pour devenir accessibles de l'extérieur du module où elle sont déclarées. Les procédures sont publiques par défaut (si elles ne sont pas déclarées privées), sauf les procédures d'évènements. Cependant, étant dans un module privé, l'appel de la procédure doit inclure le nom du module (ce qui n'est pas nécessaire lorsqu'elle est dans un module standard, public).

Magnan
 Posté le 11/06/2015 à 13:23 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Astucien

Bonjour,

Tout fonctionne parfaitement.

Petit souci avec certaines cellules, mais rattrapé à la main.

Merci encore.

A+

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
83,99 €SSD Crucial MX500 1 To à 83,99 €
Valable jusqu'au 26 Mai

Amazon propose actuellement le SSD Crucial MX500 1 To à 83,99 € livré. On le trouve ailleurs à partir de 100 €. Ce SSD salué par la critique par son rapport qualité prix imbattable offre des débits de 560 Mo/s en lecture et 510 Mo/s en écriture. Il est garanti 5 ans. Une très bonne affaire.


> Voir l'offre
74,99 €SSD PNY CS900 960 Go à 74,99 €
Valable jusqu'au 26 Mai

Cdiscount fait une promotion sur le SSD PNY CS900 960 Go qui passe à 74,99 € alors qu'on le trouve ailleurs à partir de 100 €. Ce SSD offre des vitesses d'écriture de 515 Mo/s et de lecture à 550 Mo/s. Il est garanti 3 ans. La livraison est gratuite.


> Voir l'offre
7,19 €Lot de 3 câbles Topk USB-C (2 mètres, nylon tressé, charge rapide) à 7,19 €
Valable jusqu'au 26 Mai

Amazon fait une promotion sur le lot de 3 câbles Topk USB-A vers USB-C (2 mètres, nylon tressé, charge rapide) à 7,19 € grâce à un coupon de réduction à activer sur la page du produit. On les trouve habituellement à partir de 8,99  €.


> Voir l'offre

Sujets relatifs
Relier des choix à des cellules dans excel
Ecrir par macro dans des cellules différents
Excel 2007 extraction feuille 1 dans feuille 2 avec mise en forme
Calculer date en fonction d'une valeur dans une plage de cellules
soustraction dans cellules Open Office Calc
OO Calc insérer un chiffre alternativement dans les cellules.
[extraction dans XL2010] Résolu
insérer commentaire dans cellules d'excel
saisie dans cellules
Ecrire Formule dans cellules insérées
Plus de sujets relatifs à [Extraction dans cellules]
 > Tous les forums > Forum Bureautique