Extraction base de donnees

  • Initiateur de la discussion Initiateur de la discussion malbae
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Re : Extraction base de donnees

Bonjour malbae, bienvenue sur XLD,

Pourtant pas compliqué de mettre sur le fichier ce que l'on souhaite obtenir...

Alors j'improvise avec cette macro dans Module1 (Alt+F11) :

Code:
Sub Transfert()
Dim col, a As Range
col = 1
With Feuil2 'CodeName
  .Cells.Delete
  For Each a In Feuil1.[A:A].SpecialCells(xlCellTypeConstants).Areas
    a.Copy .Cells(1, col)
    .Columns(col).AutoFit
    col = col + 1
  Next
  .Activate
End With
End Sub
A+
 

Pièces jointes

Dernière édition:
Re : Extraction base de donnees

Bonjour malbae, le forum,

Le matin on a l'esprit plus clair et maintenant je trouve ce problème excellent :

Code:
Sub Transfert()
Dim lig As Long, a As Range, cel As Range, col As Byte
lig = 2
With Feuil2 'CodeName
  .[2:65536].ClearContents
  For Each a In Feuil1.[A:A].SpecialCells(xlCellTypeConstants).Areas
    .Cells(lig, 1) = Application.Trim(a.Cells(1)) 'SUPPRESPACE
    Repere "Adresse", a, .Cells(lig, 2)
    Repere "T?l?phone", a, .Cells(lig, 5), True
    Repere "Fax", a, .Cells(lig, 6), True
    Repere "Internet", a, .Cells(lig, 7)
    Repere "Courriel", a, .Cells(lig, 8)
    Repere "Pr?sident", a, .Cells(lig, 9)
    Repere "DN", a, .Cells(lig, 10)
    For Each cel In a 'code postal et ville
      If cel Like "#####*" Then
        .Cells(lig, 3) = Left(cel, 5)
        .Cells(lig, 4) = Application.Trim(Mid(cel, 6, 99))
        Exit For
      End If
    Next
    lig = lig + 1
  Next
  For col = 1 To 10 'ajustement largeur colonnes
    .Columns(col).AutoFit
  Next
  .Activate
End With
End Sub

Sub Repere(txt$, a As Range, cel As Range, Optional epure As Boolean)
Dim ref As Range
Set ref = a.Find(txt, LookIn:=xlValues, LookAt:=xlPart)
If ref Is Nothing Then Exit Sub
txt = Application.Trim(Mid(ref, Len(txt) + 3, 99)) 'SUPPRESPACE
If epure Then txt = Replace(txt, " ", "")
cel = txt
End Sub
La macro corrige automatiquement certaines erreurs de frappe.

Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Re : Extraction base de donnees

Merci bcp job75

c'est exactement ce que je cherche
encore 1 petite Q?
1- Comment faire pour etendre la selection si d'autres champs rajoutés dans la colonne
2 - est-il possible de créer automatiquement la colonne si elle n'existe pas en feuille 1

encore merci PM
 

Pièces jointes

Re : Extraction base de donnees

Re,

Excellent malbae 🙂

1- Comment faire pour etendre la selection si d'autres champs rajoutés dans la colonne

En ajoutant des jalons "X" en Feuil1 colonne B qui permettent de repérer les lignes traitées/non traitées.

2 - est-il possible de créer automatiquement la colonne si elle n'existe pas en feuille 1

Les données qui n'étaient pas traitées sont ajoutées dans les colonnes Divers1 Divers2 Divers 3... de Feuil2.

Fichier (3) avec la macro modifiée en conséquence.

Edit : s'il y a beaucoup de données, mettez Application.ScreenUpdating = False en début de macro.

Elle sera un peu plus rapide.

A+
 

Pièces jointes

Dernière édition:
Re : Extraction base de donnees

Re,

Voici quelque chose de beaucoup mieux.

J'utilise maintenant 2 tableaux VBA pour le stockage des données (tablo) et pour le "jalonnage" (jalon).

Ils sont mémorisés pour servir dans les 2 macros.

Le traitement devrait être nettement plus rapide.

Version (4).

A+
 

Pièces jointes

Dernière édition:
Re : Extraction base de donnees

Re,

J'ai comparé les versions (3) et (4) pour 930 lignes enregistrées en feuille Résultat.

Sur mon ordi (2 Ghz) avec Excel 2003 :

- version (3) => 4,28 s

- version (4) => 3,00 s.

J'avais ajouté Application.ScreenUpdating = False.

Pour gagner encore en temps de calcul, il faudrait stocker dans un tableau les résultats avant de les injecter en bloc dans la feuille.

Edit : j'ai testé le remplissage d'une plage 930 x 10 cellule par cellule => moins de 0,4 s.

Donc cette dernière suggestion est de peu d'intérêt.

Mais j'arrête là 😎

A+
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
697
Réponses
5
Affichages
701
Réponses
6
Affichages
569
Réponses
2
Affichages
410
Retour