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

  1. #1
    Membre à l'essai
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Points : 22
    Points
    22
    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 à l'essai
    Inscrit en
    Octobre 2007
    Messages
    19
    Détails du profil
    Informations forums :
    Inscription : Octobre 2007
    Messages : 19
    Points : 17
    Points
    17
    Par défaut Re : problème de tableau avec VBA
    Bonjour,

    Pourquoi ne pas utiliser le tableau croisé dynamique.

    Ellimac

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

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Points : 22
    Points
    22
    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 éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 906
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 906
    Points : 8 539
    Points
    8 539
    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

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

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Points : 22
    Points
    22
    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 éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 906
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 906
    Points : 8 539
    Points
    8 539
    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

  7. #7
    Membre à l'essai
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Points : 22
    Points
    22
    Par défaut
    Merci Qwaz,
    J'ai testé le programme et ça marche. Par contre le fait de mettre une boucle pour les sheets font que mon tir ne marche plus vraiment. ou plôt si il marche mais mon code pour le tri devient du coup trop lourd.
    J'étais parti dans l'idée de faire un tri pour chaque spread sheet donc pour 3 codes. je me demande s'il ne serait pas possible d'en faire un seul.
    Mon code est le suivant:
    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
    Public Sub tri()
     
    ' This function permits to order series by descending
     
        Columns("A:G").Select
     
        ActiveWorkbook.Worksheets("res_a").Sort.SortFields.clear
     
        ActiveWorkbook.Worksheets("res_a").Sort.SortFields.Add Key:=Range( _
            "B2:B848"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
     
        ActiveWorkbook.Worksheets("res_a").Sort.SortFields.Add Key:=Range( _
            "C2:C848"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
     
        With ActiveWorkbook.Worksheets("res_a").Sort
            .SetRange Range("A1:G848")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
     
        End With
     
    End Sub
    Merci encore !!

    Bonjour

    J'ai crée un boutton pour exécuter la macro. Cependant avant exécution je doit supprimer toutes les valeurs de la plage de données avant de mettre les nouvelles. Mais je dois pas supprimer toute la ligne car j'ai d'autres tableaux à cotés avec des formules.
    j'ai écrie un code pour chaque sheets mais je me demande aussi si je ne peu pas le faire en même temps.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Public Sub clear_data()
    '
    ' clear all line except the first
    '
        Range(Sheets("res_a").Range("a2").Offset(0, 0), Sheets("res_a").Range("a2").End(xlDown).Offset(1, 6)).ClearContents
     
    End Sub
    Le problème avec cette requête est que si la plage de cellule est vide alors mon programme bug et pour y remédier je rempli quelques lignes manuellement puis je relance le programme. De plus elle ne supprime pas toutes les lignes.

    Merci

  8. #8
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 906
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 906
    Points : 8 539
    Points
    8 539
    Par défaut
    Salut
    Voila les modifications avec les explications dans le code.
    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
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    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, SortCell 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 vide les données éventuelle contenues dans le tableau
            'on verifie la présence de ces valeurs
            If FeuilRes.Range("A2").value <> "" Then
                'On a au moins une ligne
                FeuilRes.Range("A2", FeuilRes.Cells(Rows.count, "A").End(xlUp).Offset(0, 6)).ClearContents
                'Pour plus d'info sur cette ligne, voir plus bas dans le code
            End If
     
            '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
     
            'Le tri doit s'effectuer ici
            'Le tri sur la colonne version est à mon avis inutile puisque l'on ne garde que le numero de version le plus haut pour un numero de serie donné
     
            'On verifie que l'on a bien des données dans le tableau
            If FeuilRes.Range("A2").value <> "" Then
                'On pointe la zone qui sera à trier
                Set SortCell = FeuilRes.Range("A1", FeuilRes.Cells(Rows.count, "A").End(xlUp).Offset(0, 6))
                'J'ai vu que tu avais utilisé cette écriture mais si besoin en voila son explication
                'Ici on va chercher le tableau qui commence à la cellule A1
                'On part de la derniere cellule de la colonne A (rows.count representant le nombre de ligne de notre feuille)
                'On remonte jusqu'a la derniere cellule non vide, c'est le role de End(xlup)
                'Puis on se décale de 6 colonnes pour pointer la colonne G
                'On utilise la colonne A pour déterminer le nombre de ligne de notre tableau car cette colonne est toujours renseigné
     
                FeuilRes.Sort.SortFields.Clear
                'ici on veux faire le tri uniquement sur la colonne B
                'On va donc pointer sur une seul colonne par rapport à notre tableau
                FeuilRes.Sort.SortFields.Add Key:=SortCell.Resize(, 1).Offset(0, 1) _
                    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                'Resize modifie le pointage sur une seule colonne (il prend la 1er du tableau global (donc colonne A pour nous),
                'on se décale donc d'une colonne pour pointer la colonne B
                With FeuilRes.Sort
                    .SetRange SortCell
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        'On passe à la feuille suivante
        Next
                ' Order by descending
               ' Call tri
     
        MsgBox (" Fin de l'execution ")
     
    End Sub
    ++
    Qwaz

  9. #9
    Modérateur
    Avatar de AlainTech
    Homme Profil pro
    Consultant informatique
    Inscrit en
    Mai 2005
    Messages
    4 235
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 70
    Localisation : Belgique

    Informations professionnelles :
    Activité : Consultant informatique
    Secteur : Finance

    Informations forums :
    Inscription : Mai 2005
    Messages : 4 235
    Points : 24 327
    Points
    24 327
    Par défaut
    Attention Qwazerty,
    Citation Envoyé par Qwazerty Voir le message
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
        Dim val As Variant 'Double 'On fera directement l'arrondi
    En nommant une variable val, tu vas au devant de sérieux problèmes.
    Val est une fonction native de VBA.

  10. #10
    Expert éminent
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    3 906
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : France

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

    Informations forums :
    Inscription : Avril 2002
    Messages : 3 906
    Points : 8 539
    Points
    8 539
    Par défaut
    Citation Envoyé par AlainTech Voir le message
    Attention Qwazerty,


    En nommant une variable val, tu vas au devant de sérieux problèmes.
    Val est une fonction native de VBA.
    Salut AlainTech
    C'est pas faux , j'avoue ne pas avoir vu cela lorsque j'ai repris le code fourni, je vais corriger ça de suite.

    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
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    Option Explicit
     
    Sub test()
        Dim SERIE As String, Version As String, TERM As String, Nom As String
        Dim TheVal As Variant 'Double 'On fera directement l'arrondi
     
        Dim MaCell As Range, FindCell As Range, SortCell 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 vide les données éventuelle contenues dans le tableau
            'on verifie la présence de ces valeurs
            If FeuilRes.Range("A2").value <> "" Then
                'On a au moins une ligne
                FeuilRes.Range("A2", FeuilRes.Cells(Rows.count, "A").End(xlUp).Offset(0, 6)).ClearContents
                'Pour plus d'info sur cette ligne, voir plus bas dans le code
            End If
     
            '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(TheVal) = 0 Then TheVal= ""
     
                    '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 = TheVal
                    Else
                        'Si le numero de version est le meme, on rajoute juste les données
                        FindCell.Offset(0, OffsetTerm).value = TheVal
                    End If
                            '
                End If
     
                'On pointe la ligne suivante
                Set MaCell = MaCell.Offset(1, 0)
     
            Wend
     
            'Le tri doit s'effectuer ici
            'Le tri sur la colonne version est à mon avis inutile puisque l'on ne garde que le numero de version le plus haut pour un numero de serie donné
     
            'On verifie que l'on a bien des données dans le tableau
            If FeuilRes.Range("A2").value <> "" Then
                'On pointe la zone qui sera à trier
                Set SortCell = FeuilRes.Range("A1", FeuilRes.Cells(Rows.count, "A").End(xlUp).Offset(0, 6))
                'J'ai vu que tu avais utilisé cette écriture mais si besoin en voila son explication
                'Ici on va chercher le tableau qui commence à la cellule A1
                'On part de la derniere cellule de la colonne A (rows.count representant le nombre de ligne de notre feuille)
                'On remonte jusqu'a la derniere cellule non vide, c'est le role de End(xlup)
                'Puis on se décale de 6 colonnes pour pointer la colonne G
                'On utilise la colonne A pour déterminer le nombre de ligne de notre tableau car cette colonne est toujours renseigné
     
                FeuilRes.Sort.SortFields.Clear
                'ici on veux faire le tri uniquement sur la colonne B
                'On va donc pointer sur une seul colonne par rapport à notre tableau
                FeuilRes.Sort.SortFields.Add Key:=SortCell.Resize(, 1).Offset(0, 1) _
                    , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
                'Resize modifie le pointage sur une seule colonne (il prend la 1er du tableau global (donc colonne A pour nous),
                'on se décale donc d'une colonne pour pointer la colonne B
                With FeuilRes.Sort
                    .SetRange SortCell
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
            End If
        'On passe à la feuille suivante
        Next
                ' Order by descending
               ' Call tri
     
        MsgBox (" Fin de l'execution ")
     
    End Sub
    Et voila, je pense que c'est bon ( j'ai corrigé directement dans l’éditeur ).

    Merci
    ++
    Qwaz

  11. #11
    Membre à l'essai
    Profil pro
    Inscrit en
    Avril 2010
    Messages
    32
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2010
    Messages : 32
    Points : 22
    Points
    22
    Par défaut
    Merci Qwaz!

    C'est exactement ce qu'il me faut!

    Je vais marquer le problème comme résolu!

    Merci.

+ 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