IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Créer 3 tables de données par extraction sur la feuille 1


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Par défaut Créer 3 tables de données par extraction sur la feuille 1
    bonjour
    je suis débutante en VBA et j'ai un petit problème de code.
    mon objectif est de créer à partir des informations de la "feuil1", 3 onglets qui contiennent chacun une partie des informations de la "feuil1" mais présenté autrement.
    je m'explique:

    dans la feuil1 j'ai un tableau qui comprends plusieurs champs mais je m'intéresse seulement à 5 champs qui sont:
    - name (on a plusieurs name différents)
    - seri
    - version
    - term
    - et percentB

    à partir de ce tableau je dois extraire 3 tables pour 3 "names" différents ( a, b et f par exemple). Pour chaque table je ne conserve pour chaque "seri" que les lignes avec la "version" la plus récente. De plus, j'aimerai que les lignes avec la même "seri" et la même "version" soit concatenées pour ne donner qu'une seule ligne contenant les valeurs des autres champs (les champs 3Y, 5Y, 7Y et 10Y).

    Mon code est ci-dessous. Le problème est que j'obtiens plusieurs lignes. à chaque qu'une cellule est renseigné mon pointeur se déplace a la ligne suivante. Du coup j'ai plus de lignes qu'il ne m'en faut.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    Option Explicit
     
    Sub test()
     
        Dim SERIE, version, TERM, nom As String
        Dim val As Double
     
     
        Sheets("res_a").Select
        Range("A1").Select
     
        Sheets("feuil1").Select
        Range("a1").Select
     
            While ActiveCell.value <> ""
     
                If ActiveCell.value = "a" Then
                    nom = ActiveCell.value
                    SERIE = ActiveCell.Offset(0, 1).value
                    version = ActiveCell.Offset(0, 2).value
                    TERM = ActiveCell.Offset(0, 3).value
                    val = ActiveCell.Offset(0, 4).value
     
     
                Sheets("res_a").Select
                ActiveCell.Offset(1, 0).Select
                ActiveCell.value = nom
                ActiveCell.Offset(0, 1).value = SERIE
                ActiveCell.Offset(0, 2).value = version
     
                If TERM = "3Y" Then
                    ActiveCell.Offset(0, 3) = val * 10000
     
                ElseIf TERM = "5Y" Then
                    ActiveCell.Offset(0, 4) = val * 10000
     
                ElseIf TERM = "7Y" Then
                    ActiveCell.Offset(0, 5) = val * 10000
     
                Else
                    ActiveCell.Offset(0, 6) = val * 10000
     
                End If
                End If
     
                Sheets("feuil1").Select
     
                ActiveCell.Offset(1, 0).Select
     
            Wend
     
                ' Order by descending
               ' Call tri
     
        MsgBox (" Fin de l'execution ")
     
    End Sub


    Name Series Version Term percentB
    b 7 1 3Y
    b 7 1 10Y 1.64%
    a 7 1 7Y 1.30%
    a 7 1 10Y 1.63%
    c 7 1 5Y 0.64%
    c 7 1 10Y 1.40%
    f 7 1 10Y 4.43%
    f 7 2 5Y 4.99%
    f 7 2 10Y 4.43%
    b 11 1 3Y 0.66%
    b 11 1 5Y 1.14%
    b 11 1 7Y 1.47%
    b 11 1 10Y 1.68%
    f 11 1 3Y 5.14%
    f 11 1 5Y 4.09%
    f 11 1 7Y 4.32%
    f 11 1 10Y 4.36%
    a 11 1 3Y 0.81%
    a 11 1 5Y 1.11%
    a 11 1 7Y 1.36%
    a 11 1 10Y 1.53%
    a 7 2 3Y
    a 7 2 5Y 0.96%
    a 7 2 7Y 1.30%
    a 7 2 10Y 1.63%
    c 7 2 5Y 0.64%
    c 7 2 10Y 1.40%
    b 7 2 3Y
    b 7 2 10Y 1.64%
    f 11 2 3Y 5.14%
    f 11 2 5Y 4.09%
    f 11 2 7Y 4.32%
    f 11 2 10Y 4.36%
    f 7 3 5Y 4.99%
    f 7 3 10Y 4.43%
    f 7 4 5Y 4.99%
    f 7 4 10Y 4.43%
    f 7 5 5Y 4.99%
    f 7 5 10Y 4.43%
    b 15 1 3Y 1.66%
    b 15 1 5Y 1.97%
    b 15 1 7Y 2.11%
    b 15 1 10Y 2.20%
    a 15 1 3Y 1.03%
    a 15 1 5Y 1.31%
    a 15 1 7Y 1.45%
    a 15 1 10Y 1.55%
    f 15 1 3Y 3.66%
    f 15 1 5Y 4.60%
    f 15 1 7Y 4.92%
    f 15 1 10Y 5.02%


    resultat souhaité

    onglet: res_a

    name seri Version 3Y 5Y 7Y 10Y
    a 15 1 103 31 145 155
    a 11 1 81 111 136 153
    a 7 2 96 130 163

    resulta obtenue:

    name seri Version 3Y 5Y 7Y 10Y
    a 7 1 130
    a 7 1 163
    a 11 1 81
    a 11 1 111.2375201
    a 11 1 136.0920773
    a 11 1 152.9323278
    a 7 2 0
    a 7 2 96.26005998
    a 7 2 130.3477709
    a 7 2 162.8249332
    a 15 1 103.2113366
    a 15 1 130.5606504
    a 15 1 144.9299307
    a 15 1 154.5115675
    Fichiers attachés Fichiers attachés

  2. #2
    Membre averti
    Inscrit en
    Octobre 2007
    Messages
    19
    Détails du profil
    Informations forums :
    Inscription : Octobre 2007
    Messages : 19
    Par défaut Re : problème de tableau avec VBA
    Bonjour,

    Pourquoi ne pas utiliser le tableau croisé dynamique.

    Ellimac

  3. #3
    Membre averti
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Par défaut
    Bonjour Ellimac,

    j'ai pensé à un TCD mais le problème est que ma requete doit être automatique.
    je suis entrain de faire un outils et l'objectif est qu'il n'y ai pas d'intervention manuelle.

    Merci.

  4. #4
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut

    J'ai fait en sorte de conserver l’ossature de ton code, il traite le res_a, il te faudra modifier un peu le code pour faire une boucle res_a, res_b et res_c.
    Fais signe si tu as du mal.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    Sub test()
        'Attention, il faut repeter le type de la variable à déclarer
        Dim SERIE As String, version As String, TERM As String, nom As String
        Dim val As Integer 'Double 'On fera directement l'arrondi
     
        Dim MaCell As Range, FindCell As Range
        Dim FeuilResA As Worksheet
     
        Dim OffsetTerm As Integer
        'Inutil de selectionner la feuille ou la cellule, on n'y fera juste reference
        'Sheets("res_a").Select
        'Range("A1").Select
        Set FeuilResA = ThisWorkbook.Sheets("res_a")
     
        'Sheets("feuil1").Select
        'Range("a1").Select
        Set MaCell = ThisWorkbook.Sheets("feuil1").Range("A1")
            While MaCell.value <> ""
     
                If MaCell.value = "a" Then
                    nom = MaCell.value
                    SERIE = MaCell.Offset(0, 1).value
                    version = MaCell.Offset(0, 2).value
                    TERM = MaCell.Offset(0, 3).value
                    'On calcul directement la valeur arrondi
                    val = Int(CSng(MaCell.Offset(0, 4).value) * 10000)
     
                    'Sheets("res_a").Select
     
                    'Avant d'inscrire des donnée, il faut chercher si la seri existe déjà
                    'Pour cela on fait une recherche dans la colonne B
     
                    Set FindCell = FeuilResA.Columns("B").Find(SERIE, , xlValues)
                    'On regarde si on a trouver quelque chose
                    If FindCell Is Nothing Then
                        'La serie n'existe pas
                        'On crée la ligne
                        'On cherche la derniere cellule vierge de la colonne A et on la pointe avec notre variable Range
                        Set FindCell = FeuilResA.Cells(Rows.count, "A").End(xlUp).Offset(1)
                        'On renseigne les infos nom et serie
                        FindCell.value = nom
                        'On pointe la colonne suivante (Serie)
                        Set FindCell = FindCell.Offset(0, 1)
                        FindCell.value = SERIE
                    End If
     
                    'A partir d'ici, soit la ligne etait existante, soit on vient de créer une nouvelle ligne.
                    'Dans les 2 cas notre variable FindCell pointe bien la ligne contenant le nom et la serie recherchés
     
                    'On rajoute les données
     
                    'On regarde dans quelle colonne les données seront placées
                    Select Case TERM
                        Case "3Y"
                            OffsetTerm = 2
                        Case "5Y"
                            OffsetTerm = 3
                        Case "7Y"
                            OffsetTerm = 4
                        Case Else
                            OffsetTerm = 5
                    End Select
     
     
                    'Ici il faudra verifier la version
                    If FindCell.Offset(0, 1).value > version Then
                        'La version existante dans le tableau est superieur, on n'inscrit rien
                    ElseIf FindCell.Offset(0, 1).value < version Then
                        'version inferieur, on met a jour la version et on suprime les données existantes appartenant à une version plus ancienne
                        FindCell.Offset(0, 1).value = version
                        FindCell.Offset(0, 2).Resize(1, 4).value = ""
                        FindCell.Offset(0, OffsetTerm).value = val
                    Else
                        'Si le numero de version est le meme, on rajoute juste les données
                        FindCell.Offset(0, OffsetTerm).value = val
                    End If
                            '
     
                            'Remplacé plus haut par Select, qui est plus adapter
                            'If TERM = "3Y" Then
                            '    FindCell.Offset(0, 2) = val * 10000
                            'ElseIf TERM = "5Y" Then
                            '    FindCell.Offset(0, 3) = val * 10000
                            '
                            'ElseIf TERM = "7Y" Then
                            '    FindCell.Offset(0, 4) = val * 10000
                            'Else
                            '    FindCell.Offset(0, 5) = val * 10000
                            'End If
                End If
     
                'Sheets("feuil1").Select
     
                'On pointe la ligne suivante
                Set MaCell = MaCell.Offset(1, 0)
     
            Wend
     
                ' Order by descending
               ' Call tri
     
        MsgBox (" Fin de l'execution ")
     
    End Sub
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  5. #5
    Membre averti
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Par défaut
    Merci Qwazerty,

    C'est exactement ce que je voulais.

    Juste une question. je comptais reproduire le même code plusieurs fois pour avoir le res_b et res_c. j'ai cru comprendre qu'il est possible de le faire en même temps. Je suis novice en vba, je ne vois pas trop comment faire la boucle pour avoir les autres les résultats sur les autres sheets.

    merci encore.

    Bonjour,

    Dans mon tableau final j'ai des 0 et des valeurs manquantes. Ciomment faire pour remplacer les 0 par des vides.
    j'ai essayer la requête:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
    Sheets("res_a").Activate
        Range("a2:g2").Select
        selection.CurrentRegion.Select
        selection.Replace What:=0, Replacement:=""
    Mais maleureusement elle remplace tous les 0 par "". Par excemple si j'ai une cellule qui contient 103 j'obtients 13.
    Ce que je voudrais c'est remplacer les cellules qui sont à 0 par "".

    merci.

  6. #6
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 128
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 128
    Par défaut
    Salut

    Il serait intéressant de travailler avec Find ou avec un filtre pour trouver plus rapidement les a f c dans la liste, sans avoir a boucler sur toutes les cellules de la colonne. Prend exemple sur le Find utilisé dans le code ou dans l'aide VBA Excel (Touche F1 sur Find)

    Regarde si ça te convient

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    Option Explicit
     
    Sub test()
        Dim SERIE As String, version As String, TERM As String, nom As String
        Dim val As Variant 'Double 'On fera directement l'arrondi
     
        Dim MaCell As Range, FindCell As Range
        Dim NomRes
        Dim FeuilRes As Worksheet
        Dim OffsetTerm As Integer
     
     
     
        'On boucle sur les 3 feuilles
        For Each NomRes In Array("a", "f", "b")
            'On pointe la feuille
            Set FeuilRes = ThisWorkbook.Sheets("res_" & NomRes)
     
            'On pointe la cellule qui contient les données
            Set MaCell = ThisWorkbook.Sheets("feuil1").Range("A2")
     
            While MaCell.value <> ""
                'Ici on regarde si la cellule correspond au nom  que l'on recherche
                If MaCell.value = NomRes Then
                    SERIE = MaCell.Offset(0, 1).value
                    version = MaCell.Offset(0, 2).value
                    TERM = MaCell.Offset(0, 3).value
                    'On calcul directement la valeur arrondi
                    val = Int(CSng(MaCell.Offset(0, 4).value) * 10000)
                    'On n'affiche pas de valeur 0
                    If CInt(val) = 0 Then val = ""
     
                    'Avant d'inscrire des donnée, il faut chercher si la seri existe déjà
                    'Pour cela on fait une recherche dans la colonne B
     
                    Set FindCell = FeuilRes.Columns("B").Find(SERIE, , xlValues)
                    'On regarde si on a trouver quelque chose
                    If FindCell Is Nothing Then
                        'La serie n'existe pas
                        'On crée la ligne
                        'On cherche la derniere cellule vierge de la colonne A et on la pointe avec notre variable Range
                        Set FindCell = FeuilRes.Cells(Rows.count, "A").End(xlUp).Offset(1)
                        'On renseigne les infos nom et serie
                        FindCell.value = NomRes
                        'On pointe la colonne suivante (Serie)
                        Set FindCell = FindCell.Offset(0, 1)
                        FindCell.value = SERIE
                    End If
     
                    'A partir d'ici, soit la ligne etait existante, soit on vient de créer une nouvelle ligne.
                    'Dans les 2 cas notre variable FindCell pointe bien la ligne contenant le nom et la serie recherchés
     
                    'On rajoute les données
     
                    'On regarde dans quelle colonne les données seront placées
                    Select Case TERM
                        Case "3Y"
                            OffsetTerm = 2
                        Case "5Y"
                            OffsetTerm = 3
                        Case "7Y"
                            OffsetTerm = 4
                        Case Else
                            OffsetTerm = 5
                    End Select
     
     
                    'Ici il faudra verifier la version
                    If FindCell.Offset(0, 1).value > version Then
                        'La version existante dans le tableau est superieur, on n'inscrit rien
                    ElseIf FindCell.Offset(0, 1).value < version Then
                        'version inferieur, on met a jour la version et on suprime les données existantes appartenant à une version plus ancienne
                        FindCell.Offset(0, 1).value = version
                        FindCell.Offset(0, 2).Resize(1, 4).value = ""
                        FindCell.Offset(0, OffsetTerm).value = val
                    Else
                        'Si le numero de version est le meme, on rajoute juste les données
                        FindCell.Offset(0, OffsetTerm).value = val
                    End If
                            '
                End If
     
                'On pointe la ligne suivante
                Set MaCell = MaCell.Offset(1, 0)
     
            Wend
        'On passe à la feuille suivante
        Next
                ' Order by descending
               ' Call tri
     
        MsgBox (" Fin de l'execution ")
     
    End Sub
    Pour les modifications, j'ai passé val en type variant (qui accepte n'importe quel type) ensuite dans le code, si val = 0 alors on lui passe une chaîne vide.
    Pour la boucle, j'ai simplement donné une liste de lettres qui devront être recherchées (a, f et b), ensuite je fait référence à la feuille Res_ correspondante.

    Le code peut-être amélioré comme je te l'ai dis plus haut, mais tu auras ensuite plus de mal à le maintenir en cas de modifications ou de problèmes, à toi de voir.

    ++
    Qwaz
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [MySQL] création d'une table de donnée par php
    Par j-cpierson dans le forum PHP & Base de données
    Réponses: 3
    Dernier message: 16/10/2009, 08h29
  2. Comptage de données par intervalle sur valeur supérieure
    Par Waylander44 dans le forum Requêtes et SQL.
    Réponses: 2
    Dernier message: 20/11/2008, 20h30
  3. Réponses: 3
    Dernier message: 14/04/2008, 17h33
  4. sauvegarde liant des données par appui sur bouton
    Par Flavien44 dans le forum IHM
    Réponses: 2
    Dernier message: 11/06/2007, 18h20
  5. [C#/SQL Server 2005] Comment créer une base de donnée par le code ?
    Par FraktaL dans le forum Accès aux données
    Réponses: 4
    Dernier message: 09/09/2006, 17h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo