Récupération de données

Version imprimable

20/01/2014, 12h05
Averell1976

1 pièce(s) jointe(s)

Récupération de données

Bonjour à toutes et à tous,

Kimy_Ire m'avait efficacement aidé sur un problème: récupération de données d'un fichier EXCEL dans un autre fichier EXCEL en fonction d'une variable:
Cela concerne en fait le planning horaire de salariés en fonction de "tournes" qui vont de 1 à 6. Le fichier "EMPLOI DU TEMPS EDUCATIF 20130901_v2.xlsm" reprend donc l'ensemble des horaires par jour en fonction du numéro de tourne (ligne 2)
Le fichier "MATRICE PLANNING 2014_v5" contient une macro ("mapping") que m'a très gentillement développé Kimy_Ire et qui devrait me permettre, lorsque je la lance, de reprendre les horaires du fichier "EMPLOI DU TEMPS EDUCATIF 20130901_v2.xlsm" en fonction de la tourne que j'indique en ligne 5 et des jours de la semaine qui se mettent à jour automatiquement lorsque je sélectionne un mois dans l'encadré jaune en haut à droite. Cela marchait pour 6 salariés, mais pour les 24, j'ai un message d'erreur que je ne comprend absolument pas....
Merci de votre aide

Salut Averell1976,

Voila, je pense qu'on devrait être pas mal là :

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 mapping()
Dim cell_move As Range
Dim tourne As Integer
Dim off As Integer
Dim x As String
Dim flag As Boolean
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
flag = True
x = "EMPLOI DU TEMPS EDUCATIF 20130901_v2.xlsm"
 
For Each Wkb In Workbooks
    If Wkb.Name = x Then
        flag = False
        Exit For
    End If
Next Wkb
 
If flag Then
   'Place ici le chemin du classeur "EMPLOI DU TEMPS".
   Workbooks.Open Filename:="C:\Users\Attaché Direction\Documents\CHEF DE SERVICE\EMPLOI DU TEMPS EDUCATIF 20130901_v2.xlsm"
End If
 
 With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("MATRICE 2014")
    Set cell_move = .Range("B10")
    For i = 1 To .Rows(5).Find("*", , , , , xlPrevious).Column - 2
        For j = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row Step 2
            tourne = .Range("B5").Offset(0, i)
            off = Weekday(.Range("B7").Offset(0, i), vbMonday)
 
            With Workbooks("EMPLOI DU TEMPS EDUCATIF 20130901_v2.xlsm").Worksheets("PLANNING")
                cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 2)
            End With
        Next j
    Next i
 
End With
 
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
 
End Sub

J'ai ajouté un peu de rapidité.
Tiens moi au courant ! :ccool:

Cordialement,
Kimy

1 pièce(s) jointe(s)

Merci pour ton aide.
J'ai également simplifié pour ne pas faire appel à un fichier "EMPLOI DU TEMPS EDUCATIF", mais à un onglet contenu dans le fichier "MATRICE PLANNING".
Par contre si je met Dupont à la place de "Salarié 1" et que je lance la macro en appuyant sur le bouton "MISE A JOUR HORAIRE", j'ai un code erreur
Et idem si je change le mois dans le carré jaune en haut à droite. Au niveau des 2 lignes de code en rouge
Code:

1 2 3 4 off = Weekday(.Range("B7").Offset(0, i), vbMonday) With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("EMPLOI DU TEMPS EDUCATIF") cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 2)

Serait-ce la bonne cette fois ? :D

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
Sub mapping()
Dim cell_move As Range
Dim tourne As Integer
Dim off As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("MATRICE 2014")
    Set cell_move = .Range("B10")
    For i = 1 To .Rows(7).Find("*", , , , , xlPrevious).Column - 2
        For j = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row Step 2
            tourne = .Range("B5").Offset(0, i)
            off = Weekday(.Range("B7").Offset(0, i), vbMonday)
 
            With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("EMPLOI DU TEMPS EDUCATIF")
                If Not .Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing And Not .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                    cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 2)
                End If
            End With
        Next j
    Next i
 
End With
 
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
 
'MsgBox "Fin de la mise à jour"
End Sub

Ou plutôt :

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
Sub mapping()
Dim cell_move As Range
Dim tourne As Integer
Dim off As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("MATRICE 2014")
    Set cell_move = .Range("B10")
    .Range("C11:AG58").ClearContents
    For i = 1 To .Rows(7).Find("*", , , , , xlPrevious).Column - 2
        For j = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row Step 2
            tourne = .Range("B5").Offset(0, i)
            off = Weekday(.Range("B7").Offset(0, i), vbMonday)
 
            With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("EMPLOI DU TEMPS EDUCATIF")
                If Not .Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing And Not .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                    cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 2)
                End If
            End With
        Next j
    Next i
 
End With
 
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
 
'MsgBox "Fin de la mise à jour"
End Sub

... pour enlever les valeurs persistantes.

1 pièce(s) jointe(s)

Récupération de données

J'ai toujours un problème, sur la ligne en rouge quand je fais la mise à jour des horaires en cliquant sur le bouton "MISE A JOUR DES HORAIRES" et j'ai rien sur la ligne .
En plus, quand je changeai le mois dans le menu déroulant en cellule Z2, j'avais les jours et la colorisation des weekends qui se faisaient automatiquement; désormais, je ne sais pas pourquoi, ça ne se fait qu'après que j'ai enregistré le fichier...... Pourtant j'ai pas touché à ça......
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("MATRICE 2014") Set cell_move = .Range("B10") .Range("C11:AG58").ClearContents For i = 1 To .Rows(7).Find("*", , , , , xlPrevious).Column - 2 For j = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row Step 2 tourne = .Range("B5").Offset(0, i) off = Weekday(.Range("B7").Offset(0, i), vbMonday) With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("EMPLOI DU TEMPS EDUCATIF") If Not .Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing And Not .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 2) End If End With Next j Next i End With Application.Calculation = xlAutomatic Application.ScreenUpdating = True 'MsgBox "Fin de la mise à jour" End Sub

23/01/2014, 18h11
Kimy_Ire
Citation:

En plus, quand je changeai le mois dans le menu déroulant en cellule Z2, j'avais les jours et la colorisation des weekends qui se faisaient automatiquement; désormais, je ne sais pas pourquoi, ça ne se fait qu'après que j'ai enregistré le fichier...... Pourtant j'ai pas touché à ça......

Supprime cette partie de code :
Code:

1 2 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual
C'est elle qui génère l'erreur dont tu parles car ton classeur ne calcul plus rien de manière automatique. En effet, si tu as une erreur au milieu du code, la macro ne repassera pas par ceci :
Code:

1 2 Application.Calculation = xlAutomatic Application.ScreenUpdating = True
... ce que je ne comprends pas puisque ça marche chez moi...

As-tu EXACTEMENT le même formalisme de fichier que celui que tu m'as passé ?
J'ai la même version d'Excel... Je ne comprends donc pas...

As-tu quelque chose sur la ligne 7 en plus des dates ?

Quel est ton cas de test exactement ?

Tu as changé complètement le formalisme du fichier...

Je verrais ça demain...

Yo !

Sur ton fichier V5 :

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
Sub mapping()
Dim cell_move As Range
Dim tourne As Integer
Dim off As Integer
 
'Application.ScreenUpdating = False
'Application.Calculation = xlCalculationManual
 
With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("MATRICE 2014")
    Set cell_move = .Range("B10")
    .Range("C11:AG58").ClearContents
    For i = 1 To .Rows(7).Find("*", , , , , xlPrevious).Column - 2
        For j = 1 To .Columns(1).Find("*", , , , , xlPrevious).Row Step 2
            tourne = .Range("B5").Offset(0, i)
            off = Weekday(.Range("B7").Offset(0, i), vbMonday)
 
            With Workbooks("MATRICE PLANNING 2014_v5.xlsm").Worksheets("EMPLOI DU TEMPS EDUCATIF")
                If Not .Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing And Not .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
                    cell_move.Offset(j, i) = .Range("B1").Offset(.Columns(2).Find(cell_move.Offset(j, 0), LookIn:=xlValues, LookAt:=xlWhole).Row - 1, .Rows(2).Find(tourne, LookIn:=xlValues, LookAt:=xlWhole).Column + off - 3)
                End If
            End With
        Next j
    Next i
 
End With
 
'Application.Calculation = xlAutomatic
'Application.ScreenUpdating = True
 
'MsgBox "Fin de la mise à jour"
End Sub

C'est la fin ? =D

Tiens moi au courant ! :ccool:

Cordialement,
Kimy

27/01/2014, 21h42
Averell1976

Récupération données

Merci ç marche impeccable!!