Macro Extraction

Macro Extraction - VB/VBA/VBS - Programmation

Marsh Posté le 06-04-2005 à 15:10:40    

Bonjour, je souhaiterais metre en place une macro qui fairais cela :
 
 
En feuille 1 ma bd
Je selectionne une ligne de la bd et la ca me l'extrait sur un nouvel onglet portant le nom de la ligne selectionné avec dedans les intitulés ( première ligne de la bd en feuill 1 )et les valeurs de la ligne que je souhaite.
 
Est ce que quelqu'un aurais une petite idee de comment mi prendre ?
 
Merci beaucoup d'avance MATA  :)

Reply

Marsh Posté le 06-04-2005 à 15:10:40   

Reply

Marsh Posté le 13-04-2005 à 15:29:15    

Je n'y suis pas arriver, pour resumer je voudrais ...à partir d'une base de données comme ca :
 
 


cinsee LIBGEO ........PR1C154 PR1C155 PR1C156 PR1C157
26001 Aix-en-Diois........2........1.....0.......0
26002 Albon  ............14.......10.....2.......0
26003 Aleyrac ............0........0.....0.......0
26004 Alixan ............12........5.....0.......1


 
Et d'une feuille ou je rentrerais ceci :
 

Entité A :.....Champs
 
26002..........PR1C155
26003..........PR1C156


 
Me sorte une feuille comme suit :


cinsee LIBGEO .....PR1C155.....PR1C156  
 
26002 Albon  ........10...........2
26003 Aleyrac ........0...........0


 
En bref extraire une partie de la base en fonction de sa ligne et de sa colonne spécifié.
 
Quelqu'un pourrais t'il maider ?  :??:  
 
 
 
 

Reply

Marsh Posté le 14-04-2005 à 05:50:16    

Tu dis que tu n'y es pas arrivé.
 
Dis-nous au moins ce que tu as fait. Qu'as-tu essayé?
Quel a été le résultat? Message(s) d'erreur?
 
On est là pour donner un coup de main, PAS POUR TOUT FAIRE A VOTRE PLACE!!!!!!!!!


Message édité par AlainTech le 14-04-2005 à 09:11:43
Reply

Marsh Posté le 14-04-2005 à 10:55:43    

Bah j'ai deja essayer  x programme different, le dernier en date :
 

Public Sub EXTRACTION()
Dim I As Integer
Dim J As Integer
Dim XI As Integer
Dim XJ As Integer
Dim DETAIL As Integer
Dim NOM As String
Dim XCOLONNE As Integer
 
'******Je supprime les feuilles deja existantes *******
 
 
' *** EXTRACTION Suppression des feuilles Entité A,B ..... avant de relancer le programme
        For XI = Worksheets.Count To 2 Step -1
            If Left(Worksheets(XI).Name, 6) = "Entité" Then
            Worksheets(XI).Delete
            End If
        Next XI
        NBfeuilles = 0
' *** /EXTRACTION
 
XJ = 1
Sheets("Entités" ).Activate
 
For XI = 1 To 100 '*****je parcours la ou l'utilisaterus entres le nom des entités ( cf premier post cinsee et codegeo ) *******
        If Sheets("Entités" ).Cells(4, XJ) <> "" Then
            Sheets(5).Activate
            Set ENTITES = ActiveWorkbook.Worksheets.Add
            NOM = Left(Sheets("Entités" ).Cells(2, XJ), (Len(Sheets("Entités" ).Cells(2, XJ)) - 1))'******je nomme et creer mes onglets******
            ENTITES.Name = NOM
            NBfeuilles = NBfeuilles + 1
                 
            I = 1
            While Sheets("Entités" ).Cells(XI, XJ) <> ""
                Selection.CurrentRegion.Select
                Selection.Copy
                Sheets("NOM" ).Paste '*****je copie les libellés dans les onglets creer******
            Wend
             
            While Cells(I, J) <> 0
                Cells(I, J + 2) = "recherchev(cells(i,j);[donnee]!1$:65536);XCOLONNE" '*****je recopie dans les onglets creer la formules pour extraire de la feuille de données les details que je souhaie obtenir*****
            Wend
             
        End If
    XJ = XJ + 4
Next XI
 
end sub


 
 
Ce qui ne marche pas, c'est la formules qui utilise des données incrémenter dans VBA et non dans excel ( Cells(I, J + 2) = "recherchev(cells(i,j);[donnee]!1$:65536);XCOLONNE" ).


Message édité par MATAMATA le 14-04-2005 à 10:57:06
Reply

Marsh Posté le 14-04-2005 à 17:10:46    

Nouvelle question de la part d'un bouley a qui on repond jamais !
 
Qui sait comment ecrire en excel VBA (97) une fonction recherchev en utilisant des variables pour les adresses de cellules !
 
svp merci ! :sweat:
 
exemple ( de ce que j'aimerais que ca fasse ... ) :
 
recherchev(var1;workbook1.feuil1.adresse;vardecolonne;false)
 
MERCI

Reply

Marsh Posté le 15-04-2005 à 12:18:34    

Oh, que si, qu'on veut bien te répondre...
 
Mais faut arrêter de nous poser les questions sous forme de devinettes.
 
Avec le code que tu as envoyé, on commence à comprendre mais il manque encore un élément.
Quelle est la structure (et un exemple de contenu) de ta feuille "Entités".
Je vois que tu t'en sers pour créer de nouvelles feuilles. Donc le contenu est important pour comprendre.
 
Autre question, pourquoi actives-tu la feuille 5 alors qu'il ne t'en reste que 2 après la suppression?

Reply

Marsh Posté le 18-04-2005 à 09:31:53    

Désoler de n'avoir pas étais assez clair, mais le nez dessus depuis deux semaine j'ai du mal à avoir un oeil subjectif  :pt1cable:  
 
Voila mon programme : ( même structure que précedente ) avec des modifications :  
 

Option Explicit
Public Sub EXTRACTION(ByVal donnee)
Dim I As Integer
Dim J As Integer
Dim XI As Integer
Dim XJ As Integer
Dim XXJ As Integer
Dim XXI As Integer
Dim DETAIL As Integer
Dim NOM As String
Dim XCOLONNE As String
Dim XLIGNE As Integer
Dim Xchamps As Integer
Dim ENTITES As Object
Dim XXXJ As Integer
Dim NBfeuilles As Integer
Dim TABLE
Dim OK As Boolean
Dim XXXXJ As Integer
 
 
 
' *** EXTRACTION Suppression des feuilles Entité A,B ..... avant de relancer le programme
        Application.DisplayAlerts = False
 
        For XI = Worksheets.Count To 2 Step -1
            If Left(Worksheets(XI).Name, 6) = "Entité" Then
            Worksheets(XI).Delete
            End If
        Next XI
        NBfeuilles = 0
' *** /EXTRACTION
 
XI = 4
XJ = 1
XXXJ = 0
XXXXJ = 1
I = 3
J = 3
XXJ = 3
XXI = 2
Sheets("Entités" ).Activate
 
While XJ <= 100
        If Sheets("Entités" ).Cells(XI, XJ) <> "" Then
            Sheets(5).Activate
            Set ENTITES = ActiveWorkbook.Worksheets.Add
            NOM = Left(Sheets("Entités" ).Cells(2, XJ), (Len(Sheets("Entités" ).Cells(2, XJ)) - 2))
            ENTITES.Name = NOM
            NBfeuilles = NBfeuilles + 1
                 
 
            Sheets(1).Activate
            Sheets(1).Select
            Cells(XI, XJ).Select
            Selection.CurrentRegion.Select
            Selection.Copy
            ENTITES.Select
            Range("A1" ).Select
            ActiveSheet.Paste
             
             
            Xchamps = 3
            While Sheets("liste" ).Cells(Xchamps, 6) <> ""
                Sheets("liste" ).Select
                XCOLONNE = Cells(Xchamps, 6).Value
                ENTITES.Activate
                Cells(XXI, XXJ) = XCOLONNE
                XXJ = XXJ + 1
                Xchamps = Xchamps + 1
            Wend
             
            OK = True
            While Workbooks(donnee).Sheets(1).Cells(1, XXXXJ) <> "" And OK = True
                If Workbooks(donnee).Sheets(1).Cells(1, XXXXJ).Value = XCOLONNE Then
                    XXXJ = XXXXJ
                    OK = False
                End If
                XXXXJ = XXXXJ + 1
            Wend
             
         
         
            Sheets(NOM).Activate
             
            While Cells(I, 1) <> ""
                While Cells(2, J) <> ""
                    XLIGNE = Sheets(NOM).Cells(I, 1)
                    ActiveWindow.WindowState = xlMinimized
                    Cells.Select
                    Application.CutCopyMode = False
                    ActiveWorkbook.Names.Add Name:="TABLE", RefersToR1C1:="=PR99Y02!R1:R65536"
                    DETAIL = Application.WorksheetFunction.VLookup(XLIGNE, TABLE, XXXJ, False)
                    ActiveWindow.WindowState = xlNormal
                    Sheets(NOM).Select
                    Cells(I, J) = DETAIL
                    J = J + 1
                Wend
                J = 3
                I = I + 1
            Wend
             
        End If
        XJ = XJ + 4
Wend
 
Application.DisplayAlerts = True
 
 
End Sub


 
Exemple de la structure de ma feuille Entités : ( desoler j'ai pas reussit a l'agrandir, il faut cliquer dessus )  
 
http://img214.echo.cx/img214/882/entits2to.th.jpg
 
 
Pour ce qui est des feuilles, je ne me souviens plus pourauoi j'active la feuille 5 mais ca dois être pour l'utilisateur  :heink:  
 
 
Ce programme marche partiellement, c'est a dire, qu'il creer pour chaque Entités ( liste de codegeo comme dans le deusieme quote de ce post ) un onglet, le seul probleme reside dans l'insertion de la fonction vlookup dans ces nouvelles feuilles ...... ici >>>
 

Citation :

While Cells(I, 1) <> ""
                While Cells(2, J) <> ""
                    XLIGNE = Sheets(NOM).Cells(I, 1)
                    ActiveWindow.WindowState = xlMinimized
                    Cells.Select
                    Application.CutCopyMode = False
                    ActiveWorkbook.Names.Add Name:="TABLE", RefersToR1C1:="=PR99Y02!R1:R65536" je nomme la plage de donnée TABLE
                    DETAIL = Application.WorksheetFunction.VLookup(XLIGNE, TABLE, XXXJ, False) la syntaxe dois être mauvaise mais Xligne et XXXJ sont ont les valeurs souhaités
                    ActiveWindow.WindowState = xlNormal
                    Sheets(NOM).Select
                    Cells(I, J) = DETAIL
                    J = J + 1
                Wend
                J = 3
                I = I + 1
            Wend


 
 
j'ai essayer ici de nommer la plage TABLE, mais je ne dois pas avoir la bonne syntaxe pour que cela marche  
 
Merci à tous  :jap:  
 
 
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed