Extraction de donnees

THIERRY35 · 18 Août 2009

Bonjour à toutes et à tous,

je cherche par macro à extraire d'un fichier de 3300 lignes environs qui se trouve en feuil1,et à exporter en feuil2 :

le nom du client suivi du total de son chiffre d'affaires.

Chaque nom de client est précédé par le même libellé "AGT"
Chaque ligne de total porte le même nom "C0 TOT HORS M"
J'ai 17 fichiers à traiter, chaque mois la taille du fichier est différent.

Ci joint un extrait du fichier, les lignes à extraire sont surlignées en orange.

Merci de votre aide,
Thierry

Minick · 18 Août 2009

Re : Extraction de donnees

Salut,

Comme ceci par exemple:

Code:

Option Explicit

Sub Extraction()
    Dim ShtSrc As Worksheet, ShtDst As Worksheet
    Dim LigSrc As Integer, LigDst As Integer
    Dim TotalOk As Boolean
    
    Set ShtSrc = Worksheets("Feuil1")
    Set ShtDst = Worksheets("Feuil2")
    
    ShtDst.Cells.Clear
    ShtDst.Range("A1").Value = "LIBELLE"
    ShtDst.Range("B1").Value = "BRUT"
    ShtDst.Range("C1").Value = "REMISE"
    ShtDst.Range("D1").Value = "NET"
    
    For LigSrc = 1 To ShtSrc.Range("A65536").End(xlUp).Row
        If InStr(1, ShtSrc.Range("A" & LigSrc).Value, ": AGT ") <> 0 Then
            LigDst = ShtDst.Range("A65536").End(xlUp).Row + 1
            ShtDst.Range("A" & LigDst).Value = Mid(ShtSrc.Range("A" & LigSrc).Value, InStr(1, ShtSrc.Range("A" & LigSrc).Value, ": AGT ") + 6)
            
            TotalOk = False
            Do
                LigSrc = LigSrc + 1
                If Left(ShtSrc.Range("A" & LigSrc).Value, 13) = "C0 TOT HORS M" Then
                    TotalOk = True
                End If
            Loop While [B][COLOR=Red]Not Totalok[/COLOR][/B] And LigSrc < ShtSrc.Range("A65536").End(xlUp).Row
            
            If TotalOk Then
                ShtDst.Range("B" & LigDst & ":D" & LigDst).Value = ShtSrc.Range("H" & LigSrc & ":J" & LigSrc).Value
            End If
        End If
    Next LigSrc
    
    Set ShtSrc = Nothing
    Set ShtDst = Nothing
End Sub

Minick · 18 Août 2009

Re : Extraction de donnees

J'ai modifié mon post pour changer la condition de sorti du While que j'avais oublié de modifier

Code en rouge

THIERRY35 · 18 Août 2009

Re : Extraction de donnees

Bonjour Minick,

merci pour cette réponse ultra rapide, cà fonctionne trés bien sur le fichier réel.

Par contre, pourras tu ajouter des commentaires à ton code pour que je puisse essayer de mieux comprendre.

Certaines données que j'avais supprimées de mon exemple auront besoin d'être traitées.

Par contre, est il possible d'extraire le numéro devant le nom du client
et de le placer dans une cellule distincte (A1 par exemple) puis suivie
des autres données nom(A2) + résultats chiffrés comme ton code le fait.

MerciThierry

Minick · 18 Août 2009

Re : Extraction de donnees

Re,

Pas certain de la position a laquelle tu veux le n° de client, essaie ceci:

Code:

Option Explicit

Sub Extraction()
    Dim ShtSrc As Worksheet, ShtDst As Worksheet
    Dim LigSrc As Integer, LigDst As Integer
    Dim TotalOk As Boolean
    
    ' On affecte nos feuilles source et destination a nos variables
    Set ShtSrc = Worksheets("Feuil1")
    Set ShtDst = Worksheets("Feuil2")
    
    ' Effacement de la feuille destination
    ShtDst.Cells.Clear
    
    ' Ajout des libelles de colonne
    ShtDst.Range("A1").Value = "LIBELLE"
    ShtDst.Range("B1").Value = "BRUT"
    ShtDst.Range("C1").Value = "REMISE"
    ShtDst.Range("D1").Value = "NET"
    
    ' Pour toutes les lignes de la feuille source
    For LigSrc = 1 To ShtSrc.Range("A65536").End(xlUp).Row
        ' Si dans la colonne A on trouve la chaine ": AGT "
        If InStr(1, ShtSrc.Range("A" & LigSrc).Value, ": AGT ") <> 0 Then
            'On cherche la derniere ligne remplit dans la feuille destination + 1
            LigDst = ShtDst.Range("A65536").End(xlUp).Row + 1
            
            ' On inscrit le n° du client en colonne A
            ShtDst.Range("A" & LigDst).Value = Left(ShtSrc.Range("A" & LigSrc).Value, 5)
            
            ' on incremente la ligne destination
            LigDst = LigDst + 1
            ' On inscrit le nom du client en colonne A
            ShtDst.Range("A" & LigDst).Value = Mid(ShtSrc.Range("A" & LigSrc).Value, InStr(1, ShtSrc.Range("A" & LigSrc).Value, ": AGT ") + 6)
            
            ' Recherche de la ligne Total
            TotalOk = False
            Do
                ' on incremente le numero de ligne source
                LigSrc = LigSrc + 1
                
                ' si on trouve "C0 TOT HORS M" dans la partie gauche de la colonne A
                If Left(ShtSrc.Range("A" & LigSrc).Value, 13) = "C0 TOT HORS M" Then
                    ' on a trouve la ligne total
                    TotalOk = True
                End If
            Loop While Not TotalOk And LigSrc < ShtSrc.Range("A65536").End(xlUp).Row
            ' on fait ceci tant qu'on a pas trouve la ligne total et qu'on a pas atteind le dernier enregistrement de la feuille source
            
            ' Si on a trouve le total
            If TotalOk Then
                ' on inscrit les Totaux dans la feuille destination
                ShtDst.Range("B" & LigDst & ":D" & LigDst).Value = ShtSrc.Range("H" & LigSrc & ":J" & LigSrc).Value
            End If
        End If
    Next LigSrc
    
    ' on libere la memoire
    Set ShtSrc = Nothing
    Set ShtDst = Nothing
End Sub

THIERRY35 · 18 Août 2009

Re : Extraction de donnees

Merci pour tes commentaires,

j'ai modifié le code et obtenu en A2 le numéro de client
par contre le nom (libellé) n'apparait plus, cellule blanche.
Le code ci aprés modifié avec surement une erreur :
' ShtDst.Range("A" & LigDst).Value = Left(ShtSrc.Range("A" & LigSrc).Value, 5)
LigDst = LigDst
ShtDst.Range("B" & LigDst).Value = Mid(ShtSrc.Range("B" & LigSrc).Value, InStr(1, ShtSrc.Range("B" & LigSrc).Value, ": AGT ") + 6)

Les montants Brut Remise net sont en colonnes C D et E

Merci

Thierry

Minick · 18 Août 2009

Re : Extraction de donnees

Code:

'             ShtDst.Range("A" & LigDst).Value = Left(ShtSrc.Range("A" & LigSrc).Value, 5)
               LigDst = LigDst
ShtDst.Range("B" & LigDst).Value = Mid(ShtSrc.Range("[B][COLOR=Red]A[/COLOR][/B]" & LigSrc).Value, InStr(1, ShtSrc.Range("[B][COLOR=Red]A[/COLOR][/B]" & LigSrc).Value, ": AGT ") + 6)

Ta source ne change pas de colonne, elle est toujours en colonne A.

Par contre apparemment tu veux par exemple en A2 le n° client et en B3 le reste si j'ai bien compri.

Dans ce cas il faut modifier la LigDst sinon tu vas avoir le 2eme n° client en face
du 1er lib client et ainsi de suite.

Si j'ai bien compri change aussi ceci

Code:

LigDst = ShtDst.Range("A65536").End(xlUp).Row + 1

en

Code:

LigDst = ShtDst.Range("A65536").End(xlUp).Row + [B][COLOR=Red]2[/COLOR][/B]

ou

Code:

LigDst = ShtDst.Range("[B][COLOR=Red]B[/COLOR][/B]65536").End(xlUp).Row + 1

raidinio · 18 Août 2009

Re : Extraction de donnees

Bonjour,

c un peu hors sujet mais y a tjrs de l'extraction

actuellement je suis sur un fichier excel et je souhaite recuperer des données d'une page web verouille. jusque la j'arrive à telecharger les données je fais données> données externes> nouvelles requetes.
j'ai creer une macro de facon des que je clique su ma macro je recupere automatiquement les données, sauf que chaque fois que j'ouvre mon fichier excel une deuxiéme fois je dois modifier la requete pour que ma macro marche en fait je dois aller dans données> données externes> modifier la requete sinon j'ai un tableau tout blanc. est-ce qq peut m'aider

merci d'avance

THIERRY35 · 19 Août 2009

Re : Extraction de donnees

Minick à dit:
Code:

' ShtDst.Range("A" & LigDst).Value = Left(ShtSrc.Range("A" & LigSrc).Value, 5) LigDst = LigDst ShtDst.Range("B" & LigDst).Value = Mid(ShtSrc.Range("[B][COLOR=Red]A[/COLOR][/B]" & LigSrc).Value, InStr(1, ShtSrc.Range("[B][COLOR=Red]A[/COLOR][/B]" & LigSrc).Value, ": AGT ") + 6)

Ta source ne change pas de colonne, elle est toujours en colonne A.

Par contre apparemment tu veux par exemple en A2 le n° client et en B3 le reste si j'ai bien compri.

Dans ce cas il faut modifier la LigDst sinon tu vas avoir le 2eme n° client en face
du 1er lib client et ainsi de suite.

Si j'ai bien compri change aussi ceci

Code:

LigDst = ShtDst.Range("A65536").End(xlUp).Row + 1

en

Code:

LigDst = ShtDst.Range("A65536").End(xlUp).Row + [B][COLOR=Red]2[/COLOR][/B]

ou

Code:

LigDst = ShtDst.Range("[B][COLOR=Red]B[/COLOR][/B]65536").End(xlUp).Row + 1

Bonjour et merci Minick ça fonctionne parfaitement,
dernière problèmatique comment modifier le code rendre la feuille source variable, c'est à dire plusieur onglets sont des sources et sur la feuille de destination, on choisi dans une liste déroulante en combobox le nom de l'onglet (cellule liée en A1) pour extraire les informations correspondantes.
Merci encore et bravo pour la rapidité et la pertinence de tes réponses.
Thierry

Minick · 19 Août 2009

Re : Extraction de donnees

Salut,

Qu'entends tu par combobox (cellule liee...)?
Une liste de validation, un combobox de la boite a outil ou un
combobox de formulaire?

De plus, tu as plusieurs source mais est ce qu'une mise a jour ecrase la precedente ou non?

Eventuellement, un fichier avec cette nouvelle contrainte pour bien comprendre

THIERRY35 · 19 Août 2009

Re : Extraction de donnees

Bonjour Minick,

ci-joint fichier exemple, avec deux bases de données, le résultat
extrait dépend du choix de l'utilisateur.

Merci

Minick · 19 Août 2009

Re : Extraction de donnees

Change ces lignes

Code:

    Set ShtSrc = Worksheets("Feuil1")
    Set ShtDst = Worksheets("Feuil2")

en

Code:

    Set ShtDst = Worksheets("Feuil3")
    Set ShtSrc = Worksheets(ShtDst.Range("A2").value)

Je te laisse adapter le reste du code pour coller avec la structure de ta feuille destination.

N'hesite pas si necessaire...

THIERRY35 · 19 Août 2009

Re : Extraction de donnees

Et voilà ... tout marche nickel, grâce à ton aide du moins sur les 1ers fichiers testés.
Par contre comme la ligne de code suivante
If Left(ShtSrc.Range("A" & LigSrc).Value, 13) = "C0 TOT HORS M"
ne marche que si le fichier source contient bien sûr les mêmes termes

et comme j'ai hélas certains fichiers qui contiennent les libelles "C9 TOT HORS M" ou"C0 TOT HS M", au total 6 variantes avec un nombre de caractères différrents que je ne peux faire corriger dans les bases.

Si une fois recensées ces différentes variantes, qui seraient liées au choix de la zone par une cellule avec RechercheV peut on modifier la ligne de code ci dessus en indiquant une référence de cellule au lieu du libellé.
Ci joint modèle fichier au besoin.
Merci

Minick · 19 Août 2009

Re : Extraction de donnees

Essaie de changer cette ligne

Code:

      ' si on trouve "C0 TOT HORS M" dans la partie gauche de la colonne A
      If Left(ShtSrc.Range("A" & LigSrc).Value, 13) = "C0 TOT HORS M" Then

par

Code:

    ' si on trouve le libelle de total dans la partie gauche de la colonne A
    If Left(ShtSrc.Range("A" & LigSrc).Value, Len(ShtDst.Range("K3").Value)) = ShtDst.Range("K3").Value Then

A tester je n'ai pas teste

THIERRY35 · 19 Août 2009

Re : Extraction de donnees

Merci c'est tout bon... sauf que il n'ya pas que le code AGT à extraire
il y aussi des codes AS, CP et REA.
La base donne d'abord les clients AGT, puis les Clients CP et les clients REA.

Le code suivant que je t'avais demandé reprend bien les AGT :

If InStr(1, ShtSrc.Range("A" & LigSrc).Value, ": AGT ") <> 0 Then

Comment pour extraire les autres codes et surtout qu'ils se trouvent classés
dans le fichier destination d'abord les AgT, puis les Cp et les REA ?

Mercci

Effectuez une recherche sur Excel Downloads...

Extraction de donnees

THIERRY35

XLDnaute Occasionnel

Pièces jointes

Minick

XLDnaute Impliqué

Minick

XLDnaute Impliqué

THIERRY35

XLDnaute Occasionnel

Minick

XLDnaute Impliqué

THIERRY35

XLDnaute Occasionnel

Minick

XLDnaute Impliqué

raidinio

Guest

THIERRY35

XLDnaute Occasionnel

Minick

XLDnaute Impliqué

THIERRY35

XLDnaute Occasionnel

Pièces jointes

Minick

XLDnaute Impliqué

THIERRY35

XLDnaute Occasionnel

Pièces jointes

Minick

XLDnaute Impliqué

THIERRY35

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée