Macro Extraction

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 )

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

Macro Extraction

Sujets relatifs:

Leave a Replay