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 :

Macro lente et enlever les weekends!


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Points : 56
    Points
    56
    Par défaut Macro lente et enlever les weekends!
    Bonjour,
    deux problèmes reliés:
    1) d'abord en exécutant ce code je trouve qu'il est lent, il faut dire que "For...Next" ce n'est pas mon fort!
    2) Je vais expliquer mon problème en donnant un exemple concret:
    dans mon UserForm j'ai deux DTpicker (donc c'est une période):
    DTPicker1=2011-11-17
    DTPicker2=2011-11-21, je souhaiterais enlever les weekends entre les deux dates:
    A7=2011-11-17
    A8=2011-11-18
    A9=2011-11-21
    Pour cela je dois régler la lenteur du 1) imagine sur une période de 3 mois!
    Merci Beaucoup!

    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
    Private Sub CommandButton1_Click()
     
    Worksheets("feuil2").Visible = xlSheetHidden
     
    Worksheets("stats_perso").Visible = xlSheetVisible
    Sheets("stats_perso").Range("a6").Value = ComboBox1
    Sheets("stats_perso").Range("a7").Value = DTPicker1
     
    choix = ComboBox1.ListIndex + 1
     
    If TextBox1.Value = Sheets("Database").Cells(choix, 3).Value Then
     
    var1 = ComboBox1.Text
    var2 = DTPicker1
     
    Set f = Sheets("Feuil1").Range("f2:f20000")
    Set o = Sheets("Feuil1").Range("o2:o20000")
    Set p = Sheets("Feuil1").Range("p2:p20000")
    Set r = Sheets("Feuil1").Range("r2:r20000")
    Set s = Sheets("Feuil1").Range("s2:s20000")
    Set x = Sheets("Feuil1").Range("x2:x20000")
    Set y = Sheets("Feuil1").Range("y2:y20000")
    Set z = Sheets("Feuil1").Range("z2:z20000")
    Set aa = Sheets("Feuil1").Range("aa2:aa20000")
    Set af = Sheets("Feuil1").Range("af2:af20000")
    Set ah = Sheets("Feuil1").Range("ah2:ah20000")
    Set ai = Sheets("Feuil1").Range("ai2:ai20000")
    Set aj = Sheets("Feuil1").Range("aj2:aj20000")
    Set ak = Sheets("Feuil1").Range("ak2:ak20000")
    Set ao = Sheets("Feuil1").Range("ao2:ao20000")
    Set ax = Sheets("Feuil1").Range("ax2:ax20000")
    Set ay = Sheets("Feuil1").Range("ay2:ay20000")
    Set bb = Sheets("Feuil1").Range("bb2:bb20000")
    Set be = Sheets("Feuil1").Range("be2:be20000")
    Set bg = Sheets("Feuil1").Range("bg2:bg20000")
    Set bh = Sheets("Feuil1").Range("bh2:bh20000")
    Set bi = Sheets("Feuil1").Range("bi2:bi20000")
     
    'Set C = Range("G2:G1000")
    For i = 1 To p.Count
    A = A + (f(i) = var1) * (o(i) = var2) '* C(i)
    B = B + (f(i) = var1) * (p(i) = var2) '* C(i)
    C = C + (f(i) = var1) * (r(i) = var2)
    d = d + (f(i) = var1) * (s(i) = var2)
    e = e + (f(i) = var1) * (x(i) = var2)
    g = g + (f(i) = var1) * (y(i) = var2)
    h = h + (f(i) = var1) * (z(i) = var2)
    j = j + (f(i) = var1) * (aa(i) = var2)
    k = k + (f(i) = var1) * (af(i) = var2)
    l = l + (f(i) = var1) * (ah(i) = var2)
    m = m + (f(i) = var1) * (ai(i) = var2)
    n = n + (f(i) = var1) * (aj(i) = var2)
    q = q + (f(i) = var1) * (ak(i) = var2)
    t = t + (f(i) = var1) * (ao(i) = var2)
    u = u + (f(i) = var1) * (ax(i) = var2)
    v = v + (f(i) = var1) * (ay(i) = var2)
    w = w + (f(i) = var1) * (bb(i) = var2)
    ab = ab + (f(i) = var1) * (be(i) = var2)
    ac = ac + (f(i) = var1) * (bg(i) = var2)
    ad = ad + (f(i) = var1) * (bh(i) = var2)
    ae = ae + (f(i) = var1) * (bi(i) = var2)
     
    Next
    Sheets("stats_perso").Range("b7") = A
    Sheets("stats_perso").Range("c7") = B
    Sheets("stats_perso").Range("d7") = C
    Sheets("stats_perso").Range("e7") = d
    Sheets("stats_perso").Range("f7") = e
    Sheets("stats_perso").Range("g7") = g
    Sheets("stats_perso").Range("h7") = h
    Sheets("stats_perso").Range("i7") = j
    Sheets("stats_perso").Range("j7") = k
    Sheets("stats_perso").Range("k7") = l
    Sheets("stats_perso").Range("l7") = m
    Sheets("stats_perso").Range("m7") = n
    Sheets("stats_perso").Range("n7") = q
    Sheets("stats_perso").Range("o7") = t
    Sheets("stats_perso").Range("p7") = u
    Sheets("stats_perso").Range("q7") = v
    Sheets("stats_perso").Range("r7") = w
    Sheets("stats_perso").Range("s7") = ab
    Sheets("stats_perso").Range("t7") = ac
    Sheets("stats_perso").Range("u7") = ad
    Sheets("stats_perso").Range("v7") = ae
     
     
    ComboBox1.Text = Sheets("stats_perso").Range("a1")
     
    'pour effacer le mot de pass
    TextBox1.Value = ""
    Me.Hide
    Else
    MsgBox (ComboBox1.Text & "  votre mot de passe est erronné")
     
    TextBox1.Value = ""
    End If
    End Sub

  2. #2
    Membre averti
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    357
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2006
    Messages : 357
    Points : 355
    Points
    355
    Par défaut
    Bonjour,

    Je ferai quelque chose dans cet esprit :

    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
    Dim dt1 As Date, dt2 As Date, dt3 As Date
    Dim i As Integer
    Dim cpt As Integer
     
    dt1 = "17/11/2011"
    dt2 = "21/11/2011"
     
    With Worksheets("Feuil2")
        For i = 0 To DateDiff("d", dt1, dt2)
            dt3 = DateAdd("d", i, dt1)
            If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
                .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1) = dt3
            End If
        Next i
    End With
    (En supposant que l'on écrive le résultat sur la feuille "Feuil2")

    Si vous avez des dates qui ont un format différent (par exemple avec des - à la place des / ou autre, utilisez la fonction dateserial)

  3. #3
    Membre du Club
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Points : 56
    Points
    56
    Par défaut
    Le code que vous m'avez donné marche trè bien pour mettre des date qui se suivent dans une colonne.
    Le problème c'est que la macro fait le calcul seulement sur la première date, je pense que mon code est vraiment Basic Comment ferais-je por qu'il continu le calcul sur chacune des lingnes de la date de début à la date de Fin.
    Je vous rappel que le but du code c'est comme une SOMMEProd.
    Please HELP!!!

  4. #4
    Membre averti
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    357
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2006
    Messages : 357
    Points : 355
    Points
    355
    Par défaut
    Bonjour,

    Essaie d'expliquer ce que tu veux avec des mots et pas avec un bout de code.

    Donne un jeu de données d'entrée et le resultat que tu attends.

    Là tu me parles de sommepprod alors que dans ton premier post tu ne parles que de dates.

    Expliques nous ce que tu veux en bon francois

  5. #5
    Membre du Club
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Points : 56
    Points
    56
    Par défaut Voir le fichier joint!
    les données sont à la feuille Données:
    SOMMEPROD((Données!$A$4:$A$16=$A$2)*(Données!B$4:B$16=Calcul!A4))
    Le résultat marche très bien avec la sommeprod, mais je veux tout cela par macro, voici pourquoi;

    Le vendeur x peut varier à partir du UserForm et la date1 et la date2 (A4 à A8) aussi peuvent varier, donc les période peuvent être plus longues.

    Donc la question est: pour le vendeur X (à partitr du textbox1), combien il ya de dates qui sont du la date1 (ici 2011-11-16) à l'étape 1, et 2 et 3. le résultat vas dans chacune des cellule qui correspond à l'étape. (ici, le 16 c'est la ligne 4 et l'étape1 c'est la colonne B, donc le résultat va à la cellule B4 et ainsi de suite)



    Mêm question pour le lendemain de la date1, et ce, jusqu'à la date2.
    pour mieux comprendre, tu peux cliquer sur une des cellule B4 à D8 pour voir la formule avec sommeprod.
    Fichiers attachés Fichiers attachés

  6. #6
    Membre averti
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    357
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2006
    Messages : 357
    Points : 355
    Points
    355
    Par défaut
    Je ne comprends pas le résultat que tu attends.


    L'utilisateur doit choisir un vendeur et une période (date de début à la date de fin)

    Et il doit voir la même chose que ce que l'on voit sur la feuille calcul ?

    Pourquoi n'as-tu pas mis le vrai user form plutot qu une image ?

    Quel code s'execute lorsqu'on clique sur le bouton OK ?

  7. #7
    Membre du Club
    Profil pro
    Inscrit en
    Août 2011
    Messages
    115
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Août 2011
    Messages : 115
    Points : 56
    Points
    56
    Par défaut
    Citation Envoyé par Access Newbie Voir le message
    Je ne comprends pas le résultat que tu attends.

    L'utilisateur doit choisir un vendeur et une période (date de début à la date de fin)

    Et il doit voir la même chose que ce que l'on voit sur la feuille calcul ?
    oui, mai sil ne peut rien modifier
    Citation Envoyé par Access Newbie Voir le message
    Pourquoi n'as-tu pas mis le vrai user form plutot qu une image ?
    parcque j,ai tout refait et iL n'a pas de code derrière, je sais que la macro que j'avais fait au début faist référence à chacune des cellue, mais comme les dates vont varien les cellules de calcul aussi.
    Citation Envoyé par Access Newbie Voir le message
    Quel code s'execute lorsqu'on clique sur le bouton OK ?
    le code qui s'exécute, c'est celui qui remplace Sommeprod dans les cellule B4:D8

    Ok je viens de joindre le fichier avec la macro qui fait très bien le calcul sur une seule ligne! Vous allez tout comprendre!

    Voici le code:
    '****************************ça fait le calcul seulement sur une seule ligne (ici 4),
    'mon but est que la macro fait le calcul pour chacune des lignes de la colonne A
    'où il ya une date (la colonne A contient plusuiers dates qui s'étendent sur la période choisie
    'entre la date1 et la date2)


    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
    Private Sub CommandButton1_Click()
     
    ActiveWorkbook.RefreshAll
    Dim dt1 As Date, dt2 As Date, dt3 As Date
    Dim i As Integer
    Dim cpt As Integer
     
    dt1 = DTPicker1
    dt2 = DTPicker2
    '***************remplir la colonne A par les dates de la période Date1 à date2
    With Worksheets("Calcul")
        For i = 0 To DateDiff("d", dt1, dt2)
            dt3 = DateAdd("d", i, dt1)
    '        If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
                .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1) = dt3
    '        End If
        Next i
    End With
    '**********mettre quelques infos dans la feuille***********
    Sheets("Calcul").Range("b1").Value = ComboBox1
    Sheets("Calcul").Range("b2").Value = DTPicker1
    Sheets("Calcul").Range("c2").Value = DTPicker2
    ' ***********le calcul******************
    var1 = ComboBox1.Text
    var2 = DTPicker1
     
     
    Set a = Sheets("Données").Range("a2:a20000")
    Set B = Sheets("Données").Range("b2:b20000")
    Set C = Sheets("Données").Range("c2:c20000")
    Set D = Sheets("Données").Range("d2:d20000")
     
        For i = 1 To D.Count
     
     
            e = e + (a(i) = var1) * (B(i) = var2)
            f = f + (a(i) = var1) * (C(i) = var2)
            j = f + (a(i) = var1) * (D(i) = var2)
     
        Next
            Sheets("Calcul").Range("b4") = e
            Sheets("Calcul").Range("c4") = f
            Sheets("Calcul").Range("d4") = j
     
     
    Me.Hide
     
    End Sub
    Fichiers attachés Fichiers attachés

  8. #8
    Membre averti
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    357
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2006
    Messages : 357
    Points : 355
    Points
    355
    Par défaut
    Hum ... plus on avance moins je comprends ...

    Dans ta feuille données, sur l'étape 3 et pour le vendeur x, tu n'as pas de date au 16/11/2011, je ne vois pas vraiment par quel miracle je vais pouvoir ramener la valeur 1 ...

    Tu dis :
    Le résultat marche très bien avec la sommeprod, mais je veux tout cela par macro
    Mais le resultat attendu que tu me montres est différent du résultat obtenu par sommeprod, même sur la première ligne ...

  9. #9
    Membre chevronné Avatar de ZebreLoup
    Homme Profil pro
    Ingénieur Financier
    Inscrit en
    Mars 2010
    Messages
    994
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France, Val de Marne (Île de France)

    Informations professionnelles :
    Activité : Ingénieur Financier
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2010
    Messages : 994
    Points : 2 131
    Points
    2 131
    Par défaut
    Essaie ça

    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
    Private Const FIRST_ROW_DB = "A4"
     
    Private Function Denombrer(ByVal vendeur As String, ByVal dt As Date _
        , ByVal etapNum As Integer) As Integer
     
        Dim nb As Integer
        Dim i As Integer
        Dim ws As Worksheet
        Dim rg As Range
        Set ws = Worksheets("Données")
        Set rg = ws.Range(FIRST_ROW_DB)
     
        i = 0
        nb = 0
     
        While rg.Offset(i, 0).Value <> ""
            If rg.Offset(i, 0).Value = vendeur And rg.Offset(i, etapNum).Value = dt Then
                nb = nb + 1
            End If
            i = i + 1
        Wend
     
        Denombrer = nb
    End Function
     
    Private Sub CommandButton1_Click()
     
    ActiveWorkbook.RefreshAll
    Dim dt1 As Date, dt2 As Date, dt3 As Date
    Dim i As Integer
    Dim cpt As Integer
     
    dt1 = DTPicker1
    dt2 = DTPicker2
    '***************remplir la colonne A par les dates de la période Date1 à date2
    Dim ws As Worksheet
    Set ws = Worksheets("Calcul")
     
    Dim lastRow As Integer
    lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
     
    For i = 0 To DateDiff("d", dt1, dt2)
        dt3 = DateAdd("d", i, dt1)
    '   If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
            ws.Cells(lastRow, 1) = dt3
            ws.Cells(lastRow, 2) = Denombrer(ComboBox1.Value, dt3, 1)
            ws.Cells(lastRow, 3) = Denombrer(ComboBox1.Value, dt3, 2)
            ws.Cells(lastRow, 4) = Denombrer(ComboBox1.Value, dt3, 3)
            lastRow = lastRow + 1
    '    End If
    Next i
     
    '**********mettre quelques infos dans la feuille***********
    Sheets("Calcul").Range("b1").Value = ComboBox1
    Sheets("Calcul").Range("b2").Value = DTPicker1
    Sheets("Calcul").Range("c2").Value = DTPicker2
    ' ***********le calcul******************
     
     
    Unload Me
     
    End Sub
    « Compter en octal, c’est comme compter en décimal, si on n’utilise pas ses pouces » - Tom Lehrer
    « Il est assez difficile de trouver une erreur dans son code quand on la cherche. C’est encore bien plus dur quand on est convaincu que le code est juste. » - Steve McConnell

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [WD-2003] Macro enlever les liens de tous les fichiers ouverts
    Par nifux dans le forum VBA Word
    Réponses: 2
    Dernier message: 07/04/2014, 19h20
  2. bouton-macro enlevé les doublons
    Par _debutant dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 09/02/2012, 08h34
  3. [AC-2007] Macro pour agréger des requetes et enlever les avertissements
    Par kimai dans le forum VBA Access
    Réponses: 10
    Dernier message: 01/03/2011, 10h54
  4. [FoxPro]Instruction pour enlever les accents ?
    Par Fab-FoxPro dans le forum Autres SGBD
    Réponses: 2
    Dernier message: 19/08/2003, 15h46
  5. Enlever les espaces
    Par Claythest dans le forum Langage
    Réponses: 6
    Dernier message: 03/06/2003, 14h43

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