Votre question

Extraction de données avec une macro

Dernière réponse : dans Programmation
7 Janvier 2016 10:37:33

Bonjour...

Je vous explique mon problème...
A la base, j'ai un fichier Excel (Fichier nommé VILLE pour les besoins de cette demande)
Dans ce fichier VILLE, mes données sont toutes ou presque dans la colonne A
J'aimerai extraire une ligne parmi d'autres pour me créer ma base de données.
Dans le fichier joint, j'ai coloré ces cellules en jaune et j'ai refais une syntaxe de ma demande. (Je n'arrive pas à intégrer mon fichier à ce post...)[i[/i]

De cette ligne, je voudrais que le Nom aille dans une colonne "Nom" dans un onglet ou fichier à part etc...
J'ai réussi plus ou moins à isoler les lignes avec une macro (J'ai copié cette macro dans mon fichier)
mais la macro n'a pas pris le tri par la colonne A pour regrouper toutes les lignes et après je ne sais pas
comment faire pour supprimer les lignes qui ne me servent pas. Leur nombre & place sont aléatoires

Avec ma méthode "macro3", il me reste à supprimer les lignes vides, séparer les noms & prénoms ainsi que CP & Ville, dédoublonner à partir des noms
Ce tableau, une fois renseigné, me servira de matrice pour modifier ma base de données actuelle sans
avoir à faire les factures une par une & manuellement, encore une formule à élaborer mais j'ai bon espoir de la trouver (j'y travaille)

J'aurais donc besoin de quelqu'un pour vérifier ma première partie de macro et la corriger si besoin, mais aussi pour m'aider à compléter cette macro afin que je puisse traité tous mes fichiers de cette manière... Ça m'aiderait énormément et me ferait gagner un temps précieux !

J'espère avoir été claire dans ma demande, je vous remercie d'avance pour toute l'aide que vous pourrez m'apporté.

Je suis assez novice avec les macros malgré tout j'arrive à bidouiller... je suis un peu plus à l'aise avec les formules
Je suis sous Windows 10 - Office 2013

Autres pages sur : extraction donnees macro

7 Janvier 2016 20:16:05

Sans le code ont peut pas trop t'aider .... j'ai pus comprendre que c'etait un systeme de facturation triviale ... pourquoi ne pas utilisé un ERP ?
( bon ok c'est sortire l'uzine a gaz pour allimenter une empoule mais sa marche tres bien ^^)
http://www.dolibarr.fr/
m
0
l
7 Janvier 2016 20:46:11

Tout d'abord, merci d'avoir répondu... Un ERP C'est quoi au juste ? Désolée mais suis novice et ne comprend pas tous les termes utilisés...
Pour le code, je comptais pouvoir mettre mon fichier "Temoin" pour expliquer plus facilement mais je n'ai pas réussi...
m
0
l
Contenus similaires
Pas de réponse à votre question ? Demandez !
7 Janvier 2016 21:52:14

Le truc c'est que j'ai juste besoin de récupérer une partie de l'adresse pour remettre dans un tableau où toutes les données sont déjà triées et utilisables. Le côté commande, facture... Ne m'intéresse pas car on a déjà un logiciel qui gère ça...

Après, si avec ce logiciel je peux extraire toutes les infos que je veux ca peut aider c'est sur...

Voici la macro que j'ai crée pour débuter mon fichier :

"Sub Macro3()
'
' Macro3 Macro
'

'
Columns(""A:A"").Select
Selection.TextToColumns Destination:=Range(""A1""), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:= _
""-"", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Cells.Select
ActiveWorkbook.Worksheets(""Sheet3"").Sort.SortFields.Clear
ActiveWorkbook.Worksheets(""Sheet3"").Sort.SortFields.Add Key:=Range(""A1:A260"") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(""Sheet3"").Sort
.SetRange Range(""A1:J260"")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns(""B:E"").Select
Selection.EntireColumn.Hidden = False
Cells.Select
Selection.EntireRow.Hidden = False
Cells.Select
ActiveWorkbook.Worksheets(""Sheet3"").Sort.SortFields.Clear
ActiveWorkbook.Worksheets(""Sheet3"").Sort.SortFields.Add Key:=Range(""A1:A260"") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(""Sheet3"").Sort
.SetRange Range(""A1:J260"")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.EntireColumn.AutoFit
Range(""A5"").Select
End Sub
"
J'aimerais pouvoir montrer un imprime ecran de mon fichier de base pour illustrer ma demande ça serait plus facile pour tous le monde... mais faut qu'on me dise comment faire
m
0
l
7 Janvier 2016 22:30:45

tu appuis sur la touche imp ecran de ton clavier, tu ouvre paint ... tu colle , tu enregistre l'image , tu l'upload un peut ou tu veux ^^ https://imageshack.us/ ou autre ...

pour la poster sur le forum le plus simple, tu appuis sur le bouton repondre pour avoir l'editeur complet et ttu utilise le bouton image
m
0
l
8 Janvier 2016 01:32:38

C'est le résultat après macro (première image)
m
0
l
8 Janvier 2016 01:33:22



C'est le fichier de base
m
0
l
8 Janvier 2016 01:47:25



Et voici le fichier qu'il faudrait obtenir...
En sachant que : La cellule colorée contient l'ensemble des données convoitées (Nom Prénom Adresse CP Ville)
J'ai testé le bouton convertir qui m'a donné quelques résultats = NOMPrénom ADRESSE CPVille
du coup je l'ai intégrer dans l'enregistrement de la macro

m
0
l
10 Janvier 2016 00:20:28

Bonsoir,

Mon affaire est presque résolue...

  1. Sub Compilation()
  2. Afficher
  3. supVides
  4. Trier
  5. EffacerLignes
  6. Effacer
  7. Convertir
  8. End Sub
  9. Sub Afficher()
  10. Cells.EntireRow.Hidden = False
  11. Cells.EntireColumn.Hidden = False
  12. End Sub
  13.  
  14. Sub supVides()
  15. On Error Resume Next
  16. [A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  17. End Sub
  18.  
  19. Sub Convertir() 'convertir la colonne a avec séparateur "," & "-"
  20.  
  21. With Range("A:A") ' Colonne A
  22. ' Remplacement des "-" par des "_"
  23. .Replace what:="-", replacement:="_", lookat:=xlPart
  24. ' 'conversion dans les colonnes à partir du rang A'
  25. .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
  26. TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
  27. Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="_", _
  28. FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
  29. SendKeys "{ENTER}", True
  30. End With
  31. End Sub
  32. Sub Trier()
  33. Range("A1:A8").Sort Key1:=Range("A1")
  34. End Sub
  35. Sub EffacerLignes()
  36. ' Efface toutes les lignes si aucune cellule dans la ligne
  37. ' ne contient le caractère À:
  38. ' Attention : long temps d'exécution
  39.  
  40. Dim rg As Range, c As Range, rg2 As Range
  41. Dim i As Long, nbCol As Long, nbLig As Long, efface As Boolean
  42.  
  43.  
  44. Application.ScreenUpdating = False
  45. Set rg = ActiveCell.CurrentRegion 'toutes les données
  46. nbLig = rg.Rows.Count
  47. nbCol = rg.Columns.Count
  48.  
  49. For i = nbLig To 1 Step -1
  50. Set rg2 = Cells(i, 1).Resize(1, nbCol)
  51. efface = True
  52. For Each c In rg2
  53. If InStr(1, c.Text, "À:") > 0 Then efface = False
  54. Next c
  55. If efface Then Rows(i).EntireRow.Delete
  56.  
  57. If i Mod 500 = 0 Then Application.StatusBar = i 'compteur
  58. Next i
  59.  
  60. Application.ScreenUpdating = True
  61. End Sub
  62. Sub Effacer() 'Effacer les lignes contenant "Société X"
  63. Dim w As Range
  64. For Each w In ActiveSheet.UsedRange
  65. If w Like "Société X" Or c Like "societe x" Then c.Rows.Delete
  66. Next w
  67. End Sub


J'ai finalement avancé... Tout ce code fonctionne jusqu’à la conversion sauf quand je lui demande d'effacer une cellule car celle ci contient X. Il ne me reste finalement plus qu'à copier ces données dans mon fichier global et dédoublonner les données.

je bloque sur l'extraction de données ... les codes que j'ai testé, comme créer un nouvel onglet "Recap" et extraire les données dans Recap.

Si je met la création de Recap, au début de l’exécution de la macro, il reste sur Recap et ma macro ne fonctionne plus car il n'y a aucune données à traiter. Je n'ai pas trouvé de code permettant de revenir sur l'onglet de départ (sheet1 ou 2 ou 3... nombre variable)

Ci dessous le code de la création de récap :
  1. Sub Recap() 'création d'un nouvel onglet Recap" à l’exécution de la macro
  2. 'Pour coller les futures données dans cet onglet
  3.  
  4. Static i As Long
  5. Dim Feuille As Worksheet
  6.  
  7. i = i + 1
  8.  
  9. Set Feuille = ThisWorkbook.Worksheets.Add '
  10.  
  11. Feuille.Name = "Recap" & i ' Renommer onglet
  12.  
  13. Dim w As Worksheet
  14. For Each w In Worksheets
  15.  
  16. Next w
  17. End Sub


Et voici le code de la copie des données vers Recap :
  1. Sub Extraction() 'Extraire le tableau vers l'onglet Recap à la suite des autres extractions
  2. 'Cherche solution pour carrément l'intégrer dans un fichier "Recup Données" où toutes
  3. 'mes extractions de fichiers seraient regroupées
  4.  
  5. Set ws1 = Worksheets("Active.Sheet") 'Source - Le problème se pose ici puisque la feuille active est Recap a ce moment là
  6. Set ws2 = Worksheets("Recap") 'Cible
  7.  
  8. ' efface le contenu de la feuille cible (cette partie là est encore à adapter car je ne veux pas supprimer
  9. 'données déjà entrées mais ajouter le contenu de l'onglet traité à cette liste
  10. 'Si possible de le placer directement dans Recup données c'est encore mieux
  11. ws2.Cells.Clear
  12. ' on copie la source dans la cible
  13. ws1.Cells.Copy ws2.Range("A1") 'A1 étant variable puisque ce contenu vient derrière la dernière extraction
  14.  
  15.  
  16. With ws2
  17. ' dernière ligne du tableau copié, fait l'hypothèse que la dernière ligne de la colonne A
  18. ' sera la dernière ligne pour toutes les colonnes
  19. dl = .Range("A" & .Rows.Count).End(xlUp).Row
  20. ' on passe en revue chaque ligne à partir de la fin
  21. For i = dl To 1 Step -1
  22. ' si on trouve une ligne vide, on la supprime
  23. ' on fait l'hypothèse que si la cellule en colonne A est vide, la ligne est vide
  24. If .Cells(i, 1) = "" Then .Rows(i).Delete
  25. Next i
  26. ' Remplacement des "À:" par des "riens" (dans mon fichier ça m'est très utile mais je n'ai pas pu vérifier
  27. 'si ce code fonctionnait)
  28. .Replace what:="À:", replacement:="", lookat:=xlPart
  29. End With
  30.  
  31. End Sub


Si vous avez une piste...

Quand j'aurais réussi ce passage et que tous mes onglets seront extrait, il faudra que je dédoublonne les résultats.

Voilà, il me semble ne rien n'avoir oublié...
S'il vous manque quelque chose n'hésitez pas ;-)
m
0
l
Tom's guide dans le monde
  • Allemagne
  • Italie
  • Irlande
  • Royaume Uni
  • Etats Unis
Suivre Tom's Guide
Inscrivez-vous à la Newsletter
  • ajouter à twitter
  • ajouter à facebook
  • ajouter un flux RSS