Extraction d'adresse

EstelleL · 15 Septembre 2017

Bonjour à tous,

Je cherche à extraire des données sur Excel, je m'explique :

J'ai différents fichiers Excel, avec sur chacun, des noms, prénoms, adresse et numero de téléphone. Ces informations sont sur chaque fichier au meme endroit.

J'aimerai extraire toute ces informations dans un autre fichier Excel, pour me faire en quelque sorte un carnet d'adresse.

Est-ce possible ?

Merci par avance,

Cordialement,

ESTELLE

gosselien · 15 Septembre 2017

EstelleL à dit:
Est-ce possible ?

ESTELLE

Oui..
on va sortir la boule de cristal 🙂 ou les jumelles, les fichiers sont si loin.

P.

Victor21 · 15 Septembre 2017

Bonsoir, EstelleL. Et bienvenue sur XLD

Si l'organisation de ces données le permet (ce qu'un court extrait de vos fichiers aurait permis de voir si vous aviez eu la bonne idée de le joindre), ce devrait être possible. A suivre ?

Edit : bonsoir, gosselien.

libellule85 · 15 Septembre 2017

Bonsoir à vous tous, bonsoir le forum,

EstelleL n'a pas dû lire la charte (et notamment le paragraphe 5 du demandeur) avant de poster sa demande !

5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

Cliquez pour agrandir...

job75 · 15 Septembre 2017

Bonsoir à tous,

C'est un plaisir de voir de jolies femmes 🙂

Il s'agit d'une consolidation, nombreux exemples sur XLD, un de plus :

Code:

Private Sub CommandButton1_Click() 'bouton Consolider
Dim a, chemin$, fichier
a = Array("Fichier1.xlsx", "Fichier2.xlsx", "Fichier3.xlsx") 'fichiers à consolider
chemin = ThisWorkbook.Path & "\" 'à adapter au besoin
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
If FilterMode Then ShowAllData 'si la feuille est filtrée
Rows("2:" & Rows.Count) = "" 'RAZ
For Each fichier In a
  With Workbooks.Open(chemin & fichier).Sheets(1).UsedRange.Offset(1) '.Offset(1) si titres
    Range("A" & Rows.Count).End(xlUp)(2).Resize(.Rows.Count, .Columns.Count) = .Value
    .Parent.Parent.Close False
  End With
Next
Columns.AutoFit 'ajustement largeur
UsedRange.Sort Columns(1), xlAscending, Header:=xlYes 'tri alphabétique
With UsedRange: End With 'actualise les barres de défilement
End Sub

Télécharger les 4 fichiers dans le même dossier (le bureau).

Puis cliquer sur le bouton du fichier Consolidation.

Bonne fin de soirée.

job75 · 16 Septembre 2017

Re,

Si les tableaux peuvent être des tableaux Excel il suffit de les convertir en plage.

Edit : non c'est inutile, ce fichier (2) est identique au fichier (1).

Bonne nuit.

job75 · 16 Septembre 2017

Bonjour le fil, le forum,

Si l'on veut pouvoir organiser les résultats en tableau Excel :

Code:

Private Sub CommandButton1_Click() 'bouton Consolider
Dim a, chemin$, LO As Boolean, TS$, fichier
a = Array("Fichier1.xlsx", "Fichier2.xlsx", "Fichier3.xlsx") 'fichiers à consolider
chemin = ThisWorkbook.Path & "\" 'à adapter au besoin
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
If FilterMode Then ShowAllData 'si la feuille est filtrée
If ListObjects.Count Then LO = True: TS = ListObjects(1).TableStyle: ListObjects(1).Unlist 'si tableau Excel
Rows("2:" & Rows.Count).Delete 'RAZ
For Each fichier In a
  With Workbooks.Open(chemin & fichier).Sheets(1).UsedRange.Offset(1) '.Offset(1) si titres
    Range("A" & Rows.Count).End(xlUp)(2).Resize(.Rows.Count, .Columns.Count) = .Value
    .Parent.Parent.Close False
  End With
Next
UsedRange.Sort Columns(1), xlAscending, Header:=xlYes 'tri alphabétique
If LO Then ListObjects.Add(xlSrcRange, [A1].CurrentRegion, , xlYes).Name = "Tableau1": ListObjects(1).TableStyle = TS
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

Edit : j'ai simplifié les 3 macros.

Fichier (3).

Bon week-end.

libellule85 · 16 Septembre 2017

Bonjour Job75, le forum,

Job75 tu es vraiment incorrigible, toujours dans la recherche de la perfection.... Merci beaucoup pour toute l'aide que tu nous apporte....🙂

job75 · 16 Septembre 2017

Bonjour chère libellule 🙂

Ce n'est pas vraiment la recherche de la perfection mais le désir de supprimer les codes inutiles.

Je m'aperçois d'ailleurs qu'avec mes dernières modifications la ligne :

Code:

    If .Parent.ListObjects.Count Then .Parent.ListObjects(1).Unlist 'conversion en plage

est devenue inutile dans les fichiers (2) et (3).

Edit : comme j'aime bien les choses propres je viens de modifier les posts #6 et #7.

A+

job75 · 17 Septembre 2017

Bonjour à tous et à toutes,

Une solution qui utilise des formules de liaison :

Code:

Private Sub CommandButton1_Click() 'bouton Consolider
Dim a, chemin$, feuil$, ncol%, LO As Boolean, TS$, fichier, f$, h As Variant
a = Array("Fichier1.xlsx", "Fichier2.xlsx", "Fichier3.xlsx") 'fichiers à consolider
chemin = ThisWorkbook.Path & "\" 'à adapter au besoin
feuil = "Feuil1" 'nom des feuilles sources, à adapter
ncol = 4 'nombre de colonnes à copier, à adapter au besoin
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
If ListObjects.Count Then LO = True: TS = ListObjects(1).TableStyle: ListObjects(1).Unlist 'si tableau Excel
Rows("2:" & Rows.Count).Delete 'RAZ
For Each fichier In a
  f = "'" & chemin & "[" & fichier & "]" & feuil & "'!"
  h = ExecuteExcel4Macro("MATCH(""zzz""," & f & "C1)")
  If IsNumeric(h) Then
    With Range("A" & Rows.Count).End(xlUp)(2).Resize(h, ncol)
      .FormulaArray = "=" & f & "R1C1:R" & h & "C" & ncol
      .Value = .Value 'supprime la formule matricielle
      .Replace 0, "", xlWhole 'cellules vides
      .Rows(1).EntireRow.Delete 'supprime les titres
    End With
  End If
Next
UsedRange.Sort Columns(1), xlAscending, Header:=xlYes 'tri alphabétique
If LO Then ListObjects.Add(xlSrcRange, [A1].CurrentRegion, , xlYes).Name = "Tableau1": ListObjects(1).TableStyle = TS
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

Les feuilles sources doivent avoir le même nom et tous les tableaux doivent commencer en A1.

Fichiers joints.

L'exécution est plus rapide => 0,23 s contre 1,6 s avec les fichiers précédents.

Edit : avec 3 tableaux sources de 10 000 lignes => 3,4 s, post #7 => 3,5 s, post #6 => 2,6 s.

En effet ici les fichiers sources ne sont pas ouverts.

Bonne journée.

job75 · 17 Septembre 2017

Re,

Voyons pour terminer la question des doublons.

Trier d'abord le tableau sur les noms en colonne A, puis utiliser cette macro :

Code:

Sub DoublonSuivant()
'raccourci clavier Ctrl+d
'recherche le 1er doublon en colonne A sous la cellule active
Dim c As Range, i&
Set c = Cells(ActiveCell.Row, 1)
i = 2
While LCase(c(i)) <> LCase(c(i - 1)): i = i + 1: Wend
c(i).Select
End Sub

Ainsi on fait ce qu'on veut : conserver ou supprimer le doublon.

On ne s'appuie pas sur le prénom car celui-ci peut être incomplet ou manquant.

A+

Extraction d'adresse

EstelleL

Guest

gosselien

XLDnaute Barbatruc

Victor21

XLDnaute Barbatruc

libellule85

XLDnaute Accro

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

libellule85

XLDnaute Accro

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Discussions similaires

Extraction d'adresse

EstelleL

Guest

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency