Remplir tableau vba

Version imprimable

24/07/2015, 11h36
khech

1 pièce(s) jointe(s)

Remplir tableau vba
Bonjour,
j'ai deux tableaux dans deux onglets.
- le premier tableau calcul les intérêts pour chaque personne (id, Nom, Prénom et intérêt...)
- le second historise ou stocke les intérêts calculés pour chaque année (id, Nom, Prénom et intérêt 2013, intérêt 2014, intérêt 2015, intérêt 2016....intérêt n)
J'ai mis en pj mon exemple.
Pour le moment je n'arrive pas à mettre en place le macro qui me permet de copier l'intérêt calculé pour chaque personne dans mon 1er tableau chaque fin d'année vers mon 2nd tableau en fonction de l'année.
J'essaie de m’appuyer sur ces deux tuto pas mal pour comprendre les tableaux en vba http://silkyroad.developpez.com/vba/tableaux/#LV-B.
Merci d'avance.

Salut à toi,

C'est très dommage que tu n'aies pas proposé au moins un bout de code ! :aie:

Enfin bon, j'en ai fait un qui marche normalement, tout pourrait être fait sans passer par des variables en 3 lignes (for/copier la valeur/next)... Mais pour que ce soit plus clair, j'ai tout détaillé !

Dis-moi 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
Sub test()
 
'On va d'abord mettre tes feuilles en variables :
Dim Sh1 As Worksheet
Set Sh1 = Sheets("Interet")
 
Dim Sh2 As Worksheet
Set Sh2 = Sheets("Base")
 
'On mémorise aussi l'année
Dim Année As Integer
Année = Sh1.Range("D7")
 
'On spécifie les ranges, la colonne où tu vas lire les ID, puis celle où tu chercheras l'ID et celle où tu chercheras l'année
Dim ColID As Range
Set ColID = Sh1.Range("B10", Sh1.Range("B" & Rows.Count).End(xlUp))
 
Dim RechercheID As Range
Set RechercheID = Sh2.Range("B10", Sh2.Range("B" & Rows.Count).End(xlUp))
 
Dim RechercheAnnée As Range
Set RechercheAnnée = Sh2.Range("K9:AF9")
 
 
Dim ID As Range
'On boucle dans les différentes ID :
For Each ID In ColID.Cells
    'On cherche l'ID et l'année, puis on écrit la valeur 8 colonnes plus loin (donc l'intérêt) :
    Sh2.Cells(RechercheID.Find(ID.Text).Row, RechercheAnnée.Find(Année).Column) = ID.Offset(0, 8).Value
Next ID
 
 
End Sub

24/07/2015, 14h14
khech

re Quentin77170,
merci pour votre réponse et ça marche très bien.
C'est vrais j'aurai pu proposer quelque chose mais c'est juste ça qui manquait. J'avais jamais traité ce cas. Il me reste encore beaucoup à faire (de petits calcules) pour compléter le macro, mais je pense que ça devrait aller.
Encore merci car ce que vous avez fait c'est simple et claire.

re,
juste une que question,
pour gérer le cas d'un nouveau arrivant entre deux années. C'est à dire il est présent dans dans l'onglet Intérêt et pas dans la base ==> copier le nouveau adhérant dans la base.
Pour résoudre ce problème, à mon niveau je peux écrire une fonction qui le fait et inexécuté avant d’exécuter le macro qui copie les intérêts sinon j'ai vu qu'avec ton macro ça me génère l'erreur comme quoi il n'a pas trouvé l'ID.
Y a t il une manière plus simple de le faire avec ce même macro. Par exemple inclure un For Each.

Oui oui, la macro que j'ai proposée sous entend qu'il y a tous les ID dans la "Base", cette macro répond simplement au besoin exposé :)
Je l'ai faite depuis mon poste de travail donc je ne voulais pas prendre trop de temps à la perfectionner !

Content qu'elle te satisfasse au moins en partie.

Pour résoudre le cas où l'ID n'existerait pas dans la Base, il faut traiter le cas où RechercheID.Find(ID.Text) ne trouve rien.

Par exemple :

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
Sub test()
 
'On va d'abord mettre tes feuilles en variables :
Dim Sh1 As Worksheet
Set Sh1 = Sheets("Interet")
 
Dim Sh2 As Worksheet
Set Sh2 = Sheets("Base")
 
'On mémorise aussi l'année
Dim Année As Integer
Année = Sh1.Range("D7")
 
'On spécifie les ranges, la colonne où tu vas lire les ID, puis celle où tu chercheras l'ID et celle où tu chercheras l'année
Dim ColID As Range
Set ColID = Sh1.Range("B10", Sh1.Range("B" & Rows.Count).End(xlUp))
 
Dim RechercheID As Range
Set RechercheID = Sh2.Range("B10", Sh2.Range("B" & Rows.Count).End(xlUp))
 
Dim RechercheAnnée As Range
Set RechercheAnnée = Sh2.Range("K9:AF9")
 
 
Dim ID As Range
Dim IDTrouvé As Range
'On boucle dans les différentes ID :
For Each ID In ColID.Cells
    'On cherche l'ID et l'année, puis on écrit la valeur 8 colonnes plus loin (donc l'intérêt) :
    Set IDTrouvé = RechercheID.Find(ID.Text)
    If IDTrouvé Is Nothing Then
        Set IDTrouvé = RechercheID.Cells(RechercheID.Cells.Count).Offset(1)
        IDTrouvé.Value = ID.Text
        IDTrouvé.Offset(0, 1) = ID.Offset(0, 2).Text
        IDTrouvé.Offset(0, 2) = ID.Offset(0, 3).Text
        IDTrouvé.Offset(0, 3) = ID.Offset(0, 4).Text
        IDTrouvé.Offset(0, 4) = ID.Offset(0, 5).Text
    End If
 
    Sh2.Cells(IDTrouvé.Row, RechercheAnnée.Find(Année).Column) = ID.Offset(0, 8).Value
 
Next ID
 
End Sub

Encore une fois, ce n'est pas optimisé, c'est un peu lourd mais c'est pour le principe.

Dis-moi si ça te va ;)

Quentin

Bonjour,

comme Quentin, vu la présentation initiale j'avais aussi commencé une procédure mettant à jour uniquement l'existant …

Voici une première démonstration cherchant les ID via la méthode Find :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub Demo1() Dim Rg As Range, Rf As Range With Feuil1 C = Application.Match(.[D7].Value, Feuil2.[K9].CurrentRegion.Rows(1), 0) If IsNumeric(C) Then C = C + 9 Else Beep: Exit Sub Set Rg = Feuil2.[B9].CurrentRegion.Columns(1) Application.ScreenUpdating = False For R& = 10 To .[B9].CurrentRegion.Rows.Count + 8 Set Rf = Rg.Find(.Cells(R, 2).Value, , xlValues, xlWhole) If Rf Is Nothing Then Set Rf = Feuil2.Cells(Rows.Count, 2).End(xlUp)(2) Rf.Resize(, 5).Value = Application.Index(.Cells(R, 2).Resize(, 7).Value, , [{1,3,4,5,7}]) End If Rf(1, C).Value = .Cells(R, 10).Value Next End With Set Rf = Nothing: Set Rg = Nothing Range(Feuil2.[B10], Feuil2.[B9].End(xlDown)).Offset(, 5).Formula = "=SUM(K10:AF10)" End Sub
Une fois digérée, je pourrais en proposer une autre sans boucle, juste avec des fonctionnalités d'Excel …

_____________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse