× Aidez la recherche contre le COVID-19 avec votre ordi ! Rejoignez l'équipe PC Astuces Folding@home
 > 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 poster des messages. Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !


Les bons plans du moment PC Astuces

Tous les Bons Plans
59,99 €Switch Netgear GS116, 16 ports à 59,99 €
Valable jusqu'au 25 Novembre

Amazon propose actuellement le commutateur 16 ports Netgear GS116E-200PES à 59,99 € livré gratuitement alors qu'on le trouve ailleurs à partir de 100 €. Ce switch bénéficie de 16 connexions Ethernet haut débit commutées à 10/100/1000 Mbps en full-duplex ce qui vous permet de transférer vos fichiers sur votre réseau local à une vitesse maximum sur chaque port (jusqu'à 2000 Mbits/s). Compatible VLAN, le Netgear GS116 vous permettra également de mettre en place des réseaux locaux virtuels à l'intérieur de votre réseau local afin de mieux répartir votre bande passante et mieux gérer les priorités. Le produit est garanti 5 ans !


> Voir l'offre
168,78 €Disque dur externe Western Digital Elements Desktop USB 3.0 10 To à 168,78 € livré
Valable jusqu'au 25 Novembre

Amazon Allemagne propose actuellement le disque dur externe Western Digital Elements Desktop USB 3.0 10 To à 162,35 € (avec la TVA ajustée) grâce à un code promo automatiquement appliqué au moment du paiement. Comptez 6,43 € pour la livraison en France soit un total de 168,78 € livré. On le trouve ailleurs à partir de 200 €. Ce disque dur dispose d'un grande capacité de stockage (10 To) et d'une connectique USB 3.0 qui vous offrira des transferts rapides. Il est compatible USB 2.0. Une très bonne affaire. Notez que le disque dur n'est pas soudé et que vous pouvez le récupérer pour l'utiliser dans un ordinateur ou un NAS (il s'agit d'un disque dur CMR UltraStar DC HC 510).

Vous pouvez utiliser votre compte Amazon France sur Amazon Allemagne et il n'y a pas de douane. Si vous êtes perdu en allemand, vous pouvez traduire le site en anglais.


> Voir l'offre
39,99 €Tour multiprise parasurtenseur Aukey (6 USB + 12 secteurs) à 39,99 €
Valable jusqu'au 25 Novembre

Amazon fait une promotion sur la tour multiprise parasurtenseur Aukey (6 USB + 12 secteurs) qui passe à 39,99 € livrée gratuitement. Cette multiprise en forme de tour pourra prendre place sur un bureau ou un plan de travail et vous fournir 12 prises de courant et 6 ports USB (2.4 A) pour recharger vos appareils. Câble de 2 mètres fourni. Des protections intégrées protègent vos appareils contre les courants excessifs, la surchauffe et la surcharge. Protection contre la foudre, protection contre les surtensions.


> 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