Discussion :

[BDA53]

Salut à tous

Amis développeur de VBA, voici une nouvelle macro à checker.

Je souhaite créer une macro qui me saisissent automatiquement des données à partir d'une BDD dans un autre classeur Excel.
Pour ce faire, j'ai créer un code à partir d'un bouton. Voici le code en question :

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
 
'Ce code permet de saisir les données 
Private Sub btn_Saisie_Click()
    'Déclaration du fichier Excel de l'axe choisi
    Dim Wb As Workbook
    Set Wb = GetObject("C:\Documents\Fichier\Macro\Macro.xlsm")
    Wb.Windows(1).Visible = True
    'Déclaration des variables utilisées pour le code. l et c sont les variables des lignes et des colonnes
    'i le numéro de feuille du classeur, le compteur permet de gérer le cas des montées / descentes
    'd s'occupe de décaler les valeurs pour chaque date et r s'occupe du test sur le rang
    Dim l As Integer
    Dim c As Integer
    Dim j As Integer
    Dim d As Integer
    Dim compteur As Integer
    Dim i As Integer
    'Boucle for i parcourant toute les feuilles du classeur
    For i = 2 To 7
    'Boucle for c parcourant les colonnes de la feuille
        For c = 3 To 50
            d = 0
            'compteur = 0
            'Boucle for l parcourant les lignes de la feuille 
            For l = 2 To 9205
 
                'On ajoute la date dans sa ligne correspondante dans le tableau de résultats
                'Si la date de la ligne suivante n'est pas égale à la date actuelle alors
                'on incrémente de 1 la variable d et on réiniatilise la variable r à 1
                    For j = 30 To 68 Step 2
 
                        If Worksheets(1).Cells(l, 14) <> Worksheets(1).Cells(l - 1, 14) Then
                            d = d + 1
                            Wb.Worksheets(i).Cells(23, c + d) = Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c + d) = Weekday(Wb.Worksheets(i).Cells(23, c + d))
                            If Wb.Worksheets(1).Cells(j, c) = Worksheets(1).Cells(l, 6) Or Wb.Worksheets(1).Cells(j + 1, c) = Worksheets(1).Cells(l, 7) Then
                                'Wb.Worksheets(1).Cells(j, c + d) = Worksheets(1).Cells(l + compteur, 6)
                                'Wb.Worksheets(1).Cells(j + 1, c + d) = Worksheets(1).Cells(l + compteur, 7)
                            End If
                        Else
                            Wb.Worksheets(i).Cells(23, c) = Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c) = Weekday(Wb.Worksheets(i).Cells(23, c))
                        End If
 
                        If Worksheets(1).Cells(l, 9) = Wb.Worksheets(i).Cells(j, 2) Then
                            Wb.Worksheets(i).Cells(j, c) = Worksheets(1).Cells(l, 6)
                            Wb.Worksheets(i).Cells(j + 1, c) = Worksheets(1).Cells(l, 7)
                            compteur = compteur + 1
                        End If
 
                    Next j
                End If
 
            Next l
        Next c
    Next i
End Sub

Le code fonctionne. Seulement il met du temps à se lancer, normal je traite une BDD de 10 000 lignes.
Mais le problème vient du fait qu'après la fin de la macro, je ne peux plus ouvrir mes fichiers Excel.
Et pourtant la macro est finie, je n'ai même pas d'option tel que "Excel ne répond pas".
J'ai peut-être fait une erreur dans mon programme, mais actuellement je ne trouve pas.
Je vais continuer à chercher à coup de pas à pas. Mais si quelqu'un peut m'éclairer sur le sujet ça m'aiderait énormément

[HopPopPop]

Bonjour à tous,

Je ne pense pas que c'est dû à cela, mais il est bon de libérer les variables objet. Tu devrais mettre à la fin de ta procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Wb = Nothing

Par ailleurs, tu peux accélérer ta macro en utilisant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False  ' à mettre avant la boucle For i

puis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = True ' à mettre après la ligne Next i

[BDA53]

Merci pour ta réponse,

néanmoins ça ne change rien au problème d'éxécution

[bboy-eazy]

Bonjour,

Peut être vaut il mieux boucler en passant par des variables tableaux.

[Theze]

Bonjour,

Déjà, je ferais plutôt ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
If Dir("C:\Documents\Fichier\Macro\Macro.xlsm") = "" Then Exit Sub
Set Wb = Workbooks.Open("C:\Documents\Fichier\Macro\Macro.xlsm")

que ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Set Wb = GetObject("C:\Documents\Fichier\Macro\Macro.xlsm")
Wb.Windows(1).Visible = True

Quand on travaille sur plus d'un classeur, il est préférable de les différencier explicitement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Dim CeWb As Workbook
'...
Set CeWb = ThisWorkbook
'...
'...
Wb.Worksheets(i).Cells(23, c + d) = CeWb.Worksheets(1).Cells(l, 14)

Ensuite, ton code étant assez compliqué à déchiffrer (avec ces boucles imbriquées), il ne va pas être facile de t'aider sans plus d'explications !

[BDA53]

J'ai donc fait quelques modifs, ce qui donne le code 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
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
 
Option Explicit
 
'Cette code permet de saisir les données de la feuille comptage dans la feuille de l'axe choisi'
Private Sub btn_Saisie_Click()
    'Déclaration du fichier Excel de l'axe choisi
    Dim Wb As Workbook
    Set Wb = GetObject("C:\Users\9404915j\Documents\FichierSNCF\MacroComptage\MacroMetzForbach.xlsm")
    Wb.Windows(1).Visible = True
 
    'Déclaration des variables utilisées pour le code. l et c sont les variables des lignes et des colonnes
    'i le numéro de feuille du classeur, le compteur permet de gérer le cas des montées / descentes
    'd s'occupe de décaler les valeurs pour chaque date et r s'occupe du test sur le rang
    Dim t(9205, 50) As Integer
    Dim l, c As Integer
    Dim j As Integer
    Dim d As Integer
    Dim compteur As Integer
    Dim i As Integer
 
 
    'Boucle for i parcourant toute les feuilles du classeur
    Application.ScreenUpdating = False  ' à mettre avant la boucle For i
 
    Dim CeWb As Workbook
    Set CeWb = ThisWorkbook
 
    For i = 2 To 7
    'Boucle for c parcourant les colonnes de la fiche horaire
 
        For c = LBound(t, 2) To UBound(t, 2)
 
            d = 0
            compteur = 0
            'Boucle for l parcourant les lignes de la feuille de comptage
            For l = LBound(t, 1) To UBound(t, 1)
 
                If CeWb.Worksheets(1).Cells(l, 1) = Wb.Worksheets(i).Cells(3, c) Then
                'On ajoute la date dans sa ligne correspondante dans le tableau de résultats
                'Si la date de la ligne suivante n'est pas égale à la date actuelle alors
                'on incrémente de 1 la variable d et on réiniatilise la variable r à 1
 
                    For j = 30 To 68 Step 2
 
                        If CeWb.Worksheets(1).Cells(l, 14) <> CeWb.Worksheets(1).Cells(l - 1, 14) Then
 
                            d = d + 1
 
                            Wb.Worksheets(i).Cells(23, c + d) = CeWb.Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c + d) = Weekday(Wb.Worksheets(i).Cells(23, c + d))
 
                            If Wb.Worksheets(1).Cells(j, c) = CeWb.Worksheets(1).Cells(l, 6) Or Wb.Worksheets(1).Cells(j + 1, c) = CeWb.Worksheets(1).Cells(l, 7) Then
                                Wb.Worksheets(1).Cells(j, c + d) = CeWb.Worksheets(1).Cells(l + compteur, 6)
                                Wb.Worksheets(1).Cells(j + 1, c + d) = CeWb.Worksheets(1).Cells(l + compteur, 7)
                            End If
 
                        Else
                            Wb.Worksheets(i).Cells(23, c) = CeWb.Worksheets(1).Cells(l, 14)
                            Wb.Worksheets(i).Cells(24, c) = Weekday(Wb.Worksheets(i).Cells(23, c))
                        End If
 
                        If CeWb.Worksheets(1).Cells(l, 9) = Wb.Worksheets(i).Cells(j, 2) Then
                            Wb.Worksheets(i).Cells(j, c) = CeWb.Worksheets(1).Cells(l, 6)
                            Wb.Worksheets(i).Cells(j + 1, c) = CeWb.Worksheets(1).Cells(l, 7)
                            compteur = compteur + 1
                        End If
 
                    Next j
 
                End If
 
            Next l
 
        Next c
 
    Next i
 
    Application.ScreenUpdating = True ' à mettre après la ligne Next i
    Set Wb = Nothing
 
End Sub

Le problème reste inchangé.

Pour répondre à Theze, mon but avec ce programme est de saisir automatiquement à partir d'un clique bouton mes données provenant d'un classeur excel et de les ajouter à une feuille existante de calcul.
Cette feuille contient une fiche horaire ayant en intitulé colonne un numéro ID, une période (été,scolaire) et intitulé ligne des villes.
Avec cette fiche, je réalise en dessous un tableau de résultats.

Mon tableau de résultats où les données doivent être saisies, a quelques particularités :
-Pour chaque ville, mon tableau a 2 lignes de résultats
-Pour chaque numéro ID, il peut y avoir plusieurs séries de résultats. Ce qui fait que la date est différente selon chaque série.
-Je souhaite afficher la date où le résultat a été effectué. Puis ajouter en dessous de la date, le jour (lundi,mardi,mercredi,etc...). La date étant une donnée de la BDD et non le jour.
-Je rajoute des lignes de "total" des résultats, qui sont calculées directement avec des formules excel.

Voilà ! Je n'ai peut-être pas été très clair dans mes explications, alors n'hésitez pas à me dire ce que vous n'avez pas compris