Créer 3 tables de données par extraction sur la feuille 1 [Résolu]

[katypati]

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 :

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

[Ellimac]

Bonjour,

Pourquoi ne pas utiliser le tableau croisé dynamique.

Ellimac

[katypati]

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.

[Qwazerty]

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 :

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

[katypati]

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 :

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.

[Qwazerty]

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 :

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

[katypati]

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 :

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 :

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

[Qwazerty]

Salut
Voila les modifications avec les explications dans le code.

Code :

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

[AlainTech]

Attention Qwazerty,

Envoyé par Qwazerty

Code :

    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.

[Qwazerty]

Envoyé par AlainTech

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 :

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

[katypati]

Merci Qwaz!

C'est exactement ce qu'il me faut!

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

Merci.