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 :

Aide pour réduction de code


Sujet :

Macros et VBA Excel

  1. #1
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut Aide pour réduction de code
    Bonjour forum

    est ce que possible de réduire se code :
    Merci
    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
     
    Private Sub CommandButton2_Click()
     Dim sh
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
     
            Sheets("ASSURANCE").Range("B3:C32").Copy Sheets(sh).Range("B3")
            Sheets("ASSURANCE").Range("B36:C65").Copy Sheets(sh).Range("B36")
            Sheets("ASSURANCE").Range("B69:C98").Copy Sheets(sh).Range("B69")
            Sheets("ASSURANCE").Range("B102:C131").Copy Sheets(sh).Range("B102")
            Sheets("ASSURANCE").Range("B135:C164").Copy Sheets(sh).Range("B135")
            Sheets("ASSURANCE").Range("B168:C197").Copy Sheets(sh).Range("B168")
            Sheets("ASSURANCE").Range("B201:C230").Copy Sheets(sh).Range("B201")
            Sheets("ASSURANCE").Range("B234:C263").Copy Sheets(sh).Range("B234")
            Sheets("ASSURANCE").Range("B267:C296").Copy Sheets(sh).Range("B267")
            Sheets("ASSURANCE").Range("B300:C329").Copy Sheets(sh).Range("B300")
     
            Sheets("ASSURANCE").Range("B333:C362").Copy Sheets(sh).Range("B333")
            Sheets("ASSURANCE").Range("B366:C395").Copy Sheets(sh).Range("B366")
            Sheets("ASSURANCE").Range("B399:C428").Copy Sheets(sh).Range("B399")
            Sheets("ASSURANCE").Range("B432:C461").Copy Sheets(sh).Range("B432")
            Sheets("ASSURANCE").Range("B465:C494").Copy Sheets(sh).Range("B465")
            Sheets("ASSURANCE").Range("B498:C527").Copy Sheets(sh).Range("B498")
            Sheets("ASSURANCE").Range("B531:C560").Copy Sheets(sh).Range("B531")
            Sheets("ASSURANCE").Range("B564:C593").Copy Sheets(sh).Range("B564")
            Sheets("ASSURANCE").Range("B597:C626").Copy Sheets(sh).Range("B597")
            Sheets("ASSURANCE").Range("B630:C659").Copy Sheets(sh).Range("B630")
     
            Sheets("ASSURANCE").Range("B663:C692").Copy Sheets(sh).Range("B663")
            Sheets("ASSURANCE").Range("B696:C725").Copy Sheets(sh).Range("B696")
            Sheets("ASSURANCE").Range("B729:C758").Copy Sheets(sh).Range("B729")
            Sheets("ASSURANCE").Range("B762:C791").Copy Sheets(sh).Range("B762")
            Sheets("ASSURANCE").Range("B795:C824").Copy Sheets(sh).Range("B795")
            Sheets("ASSURANCE").Range("B828:C857").Copy Sheets(sh).Range("B828")
            Sheets("ASSURANCE").Range("B861:C890").Copy Sheets(sh).Range("B861")
            Sheets("ASSURANCE").Range("B894:C923").Copy Sheets(sh).Range("B894")
            Sheets("ASSURANCE").Range("B927:C956").Copy Sheets(sh).Range("B927")
            Sheets("ASSURANCE").Range("B960:C989").Copy Sheets(sh).Range("B960")
     
            Sheets("ASSURANCE").Range("B993:C1022").Copy Sheets(sh).Range("B993")
            Sheets("ASSURANCE").Range("B1026:C1055").Copy Sheets(sh).Range("B1026")
            Sheets("ASSURANCE").Range("B1059:C1088").Copy Sheets(sh).Range("B1059")
            Sheets("ASSURANCE").Range("B1092:C1121").Copy Sheets(sh).Range("B1092")
            Sheets("ASSURANCE").Range("B1125:C1154").Copy Sheets(sh).Range("B1125")
            Sheets("ASSURANCE").Range("B1158:C1187").Copy Sheets(sh).Range("B1158")
            Sheets("ASSURANCE").Range("B1191:C1220").Copy Sheets(sh).Range("B1191")
            Sheets("ASSURANCE").Range("B1224:C1253").Copy Sheets(sh).Range("B1224")
            Sheets("ASSURANCE").Range("B1257:C1286").Copy Sheets(sh).Range("B1257")
            Sheets("ASSURANCE").Range("B1290:C1319").Copy Sheets(sh).Range("B1290")
     
     
            Sheets("ASSURANCE").Range("B1323:C1352").Copy Sheets(sh).Range("B1323")
            Sheets("ASSURANCE").Range("B1356:C1385").Copy Sheets(sh).Range("B1356")
            Sheets("ASSURANCE").Range("B1389:C1418").Copy Sheets(sh).Range("B1389")
            Sheets("ASSURANCE").Range("B1422:C1451").Copy Sheets(sh).Range("B1422")
            Sheets("ASSURANCE").Range("B1455:C1484").Copy Sheets(sh).Range("B1455")
            Sheets("ASSURANCE").Range("B1488:C1517").Copy Sheets(sh).Range("B1488")
            Sheets("ASSURANCE").Range("B1521:C1550").Copy Sheets(sh).Range("B1521")
            Sheets("ASSURANCE").Range("B1554:C1583").Copy Sheets(sh).Range("B1554")
            Sheets("ASSURANCE").Range("B1587:C1616").Copy Sheets(sh).Range("B1587")
            Sheets("ASSURANCE").Range("B1620:C1649").Copy Sheets(sh).Range("B1620")
     
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
            ActiveWorkbook.Save
    End Sub

  2. #2
    Expert éminent sénior Avatar de Menhir
    Homme Profil pro
    Ingénieur
    Inscrit en
    juin 2007
    Messages
    14 215
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : Ingénieur
    Secteur : Industrie

    Informations forums :
    Inscription : juin 2007
    Messages : 14 215
    Points : 29 173
    Points
    29 173
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Private Sub CommandButton2_Click()
     Dim sh As String, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(sh).Range("B" & i)
            Next i
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
        ActiveWorkbook.Save
    End Sub
    Avoir utilisé des numéros pour tes noms d'onglets (01, 02, 03, etc.) t'aurait évité ce long Array et sans doute facilité les traitements futurs.
    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion.

  3. #3
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut
    Citation Envoyé par Menhir Voir le message
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Private Sub CommandButton2_Click()
     Dim sh As String, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
    End Sub
    Rebonjour
    merci infiniment Menhir
    j'ai cette erreurs
    Nom : Capture.JPG
Affichages : 34
Taille : 46,7 Ko

  4. #4
    Membre expert
    Profil pro
    Inscrit en
    février 2007
    Messages
    2 260
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2007
    Messages : 2 260
    Points : 3 773
    Points
    3 773
    Par défaut
    Bonjour à tous,

    remet ton tout court, qu'il soit Variant.
    eric

  5. #5
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut
    Citation Envoyé par Menhir Voir le message
    [CODE]Private Sub CommandButton2_Click()
    remet ton tout court, qu'il soit Variant.
    eric
    Bonjour à tous,
    Mémé si je mais next sur ce code
    j'ai cette erreur
    Nom : Capture2.JPG
Affichages : 26
Taille : 75,4 Ko
    Merci

  6. #6
    Membre expert
    Profil pro
    Inscrit en
    février 2007
    Messages
    2 260
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2007
    Messages : 2 260
    Points : 3 773
    Points
    3 773
    Par défaut
    Oui, on ne peut qu'être d'accord avec lui.
    Pas toi ?

  7. #7
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut
    Citation Envoyé par eriiic Voir le message
    Oui, on ne peut qu'être d'accord avec lui.
    Pas toi ?
    re;
    j'ai pas compris

  8. #8
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    619
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 619
    Points : 1 010
    Points
    1 010
    Par défaut
    Bonjour,

    Pour peut-être clore ce dialogue de sourds, le code corrigé
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Private Sub CommandButton2_Click()
     Dim sh As Variant, i As Long
        Application.ScreenUpdating = 0
        For Each sh In Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(sh).Range("B" & i)
            Next i
        Next sh
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"     
        ActiveWorkbook.Save
    End Sub

  9. #9
    Rédacteur

    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    janvier 2010
    Messages
    9 025
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : janvier 2010
    Messages : 9 025
    Points : 21 402
    Points
    21 402
    Billets dans le blog
    9
    Par défaut
    Bonjour,
    j'ai pas compris
    Cela signifie qu'il n'y a pas de Next et également qu'il n'y a pas de End If et donc à force de ne pas fermer convenablement les boucles ou les structures conditionnelles, un message non explicite est possible
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Quelques contributions : USERFORM - Créer, Consulter, Modifier et Supprimer des enregistrements à l'aide d'un formulaire - Géolocalisation d'une adresse avec Excel et Google sans VBA

  10. #10
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut
    Citation Envoyé par Menhir Voir le message
    Bonjour,
    Citation Envoyé par eriiic Voir le message
    Bonjour à tous,]
    Citation Envoyé par Philippe Tulliez Voir le message
    Bonjour,
    bonjour forum

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
     
    Private Sub CommandButton1_Click()
    Dim Nom$
     If RNHB.ListIndex = -1 Then MsgBox "Vous devez Sélectionner un mois avant de pouvoir transférer!!", , "Manque de choix": Exit Sub
        Application.ScreenUpdating = 0
     
                For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy Sheets(C1.Value).Range("B" & i)
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
            ActiveWorkbook.Save
    End Sub
    Se code et lier avec cette combobox

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Private Sub Workbook_Open()
        Dim sh
        Feuil19.RNHB.Clear
        For Each sh In Array("ASSURANCE", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT")
            Feuil19.RNHB.AddItem sh
        Next sh	
    End Sub
    a la fin du macro je trouve devant moi cette erreur
    Nom : Capture.3JPG.JPG
Affichages : 21
Taille : 16,5 Ko

  11. #11
    Expert éminent
    Homme Profil pro
    Inscrit en
    août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : août 2010
    Messages : 3 453
    Points : 6 856
    Points
    6 856
    Par défaut
    Bonjour,

    Ou encore avec l'objet Worksheet ce qui à mon sens est bien plus propre et sans équivoque :
    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
     
    Private Sub CommandButton2_Click()
     
        Dim sh As Worksheet
        Dim i As Long
     
        Application.ScreenUpdating = 0
     
        For Each sh In Worksheets(Array("SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT"))
     
            For i = 3 To 1620 Step 33
                Sheets("ASSURANCE").Range("B" & i & ":C" & (i + 29)).Copy sh.Range("B" & i)
            Next i
     
        Next sh
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
     
        ActiveWorkbook.Save
     
    End Sub
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
     
    Private Sub Workbook_Open()
     
        Dim sh As Worksheet
     
        Feuil19.RNHB.Clear
     
        For Each sh In Worksheets(Array("ASSURANCE", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE", "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT"))
            Feuil19.RNHB.AddItem sh.Name
        Next sh
     
    End Sub
    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
     
    Private Sub CommandButton1_Click()
     
        Dim Nom$
        Dim I As Integer
     
        If RNHB.ListIndex = -1 Then MsgBox "Vous devez Sélectionner un mois avant de pouvoir transférer!!", , "Manque de choix": Exit Sub
        Application.ScreenUpdating = 0
     
        For I = 3 To 1620 Step 33
            Sheets("ASSURANCE").Range("B" & I & ":C" & (I + 29)).Copy Sheets(RNHB.List(RNHB.ListIndex)).Range("B" & I)
        Next I
     
        MsgBox "Enregistré avec succès" & vbCrLf & "Cliquez sur OK pour fermer", Title:="Info"
     
        ActiveWorkbook.Save
     
    End Sub

  12. #12
    Futur Membre du Club
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    novembre 2019
    Messages
    10
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Maroc

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2019
    Messages : 10
    Points : 8
    Points
    8
    Par défaut
    Citation Envoyé par Theze Voir le message
    Bonjour,
    Re Forum
    Merci infiniment tous marcher très bien.
    J'ai un petit problème avec le code ça marche trop long ,il dépasser 3 minute pour transférer les donnée.
    Est il possible de régler ce problème.

Discussions similaires

  1. [VB.NET] besoin d'aide pour déchiffrer un code
    Par pcdj dans le forum Windows Forms
    Réponses: 10
    Dernier message: 27/06/2006, 12h32
  2. Aide pour déboguer un code
    Par raou123 dans le forum Assembleur
    Réponses: 3
    Dernier message: 12/04/2006, 14h23
  3. Aide pour comprendre un code
    Par Spacy_green dans le forum Assembleur
    Réponses: 2
    Dernier message: 13/02/2006, 14h22
  4. Aide pour comprendre le code
    Par jfreuff dans le forum Assembleur
    Réponses: 2
    Dernier message: 31/01/2006, 18h54
  5. Je besoin d'aide pour terminer mon code
    Par Paulinho dans le forum C++
    Réponses: 7
    Dernier message: 07/11/2005, 00h30

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