Microsoft 365 Réduire la taille de la macro ?

guiyom · 3 Juin 2023

Bonjour,

Je viens de réaliser une macro VBA très répétitive et plutôt longue. Elle est tellement longue qu'Excel refuse de l'exécuter, indiquant que la procédure est trop grande.

Une fois de plus, mon manque de connaissances me fait défaut. C'est pourquoi je vous sollicite afin de savoir s'il est possible de l'a réduire.

Ma macro consiste à coller des informations sur les 35 pages Excel, de "BQ1" à "BQ35", en fonction du type de fruits ("AAA", "BBB", "CCC", "DDD", "EEE").

Bien cordialement

VB:

Dim jour As String
Dim mois As String
Dim annee As String
Dim chemin As String
Dim txt_name As String
Dim pomme As String
Dim poire As String
Dim fraise As String
Dim raisin As String
Dim orange As String
Dim mandarine As String
Dim abricot As String
Dim ligne As String

jour = Format(Day(CDate(Worksheets("PDF").Range("u1"))), "00")
mois = Format(Month(CDate(Worksheets("PDF").Range("u1"))), "00")
annee = Cells(4, 21).Value


Application.ScreenUpdating = False

chemin = ActiveWorkbook.Path & "\" & "TXTs\"
   
   
If bq1.Name <> "BQ1" Then
   
    If Dir(chemin & "\" & bq1.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
   
        txt_name = bq1.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(9, 8).Value = pomme
        Cells(9, 9).Value = poire
        Cells(9, 10).Value = fraise
        Cells(9, 11).Value = raisin
        Cells(9, 12).Value = orange
        Cells(9, 13).Value = mandarine
        Cells(9, 14).Value = abricot


            If Sheets("Parametrage").Range("D4").Value = "AAA" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "BBB" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "CCC" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "DDD" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D4").Value = "EEE" Then

                ThisWorkbook.Sheets(bq1.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If

        Workbooks(2).Close (False)
       
    Else
   
        MsgBox (bq1.Name & " est introuvable")
   
    End If
   
End If
   
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq2.Name <> "BQ2" Then
 
    If Dir(chemin & "\" & bq2.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
   
        txt_name = bq2.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(10, 8).Value = pomme
        Cells(10, 9).Value = poire
        Cells(10, 10).Value = fraise
        Cells(10, 11).Value = raisin
        Cells(10, 12).Value = orange
        Cells(10, 13).Value = mandarine
        Cells(10, 14).Value = abricot

            If Sheets("Parametrage").Range("D5").Value = "AAA" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "BBB" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "CCC" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "DDD" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D5").Value = "EEE" Then

                ThisWorkbook.Sheets(bq2.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
   
    Else
   
        MsgBox (bq2.Name & " est introuvable")
   
    End If
           
End If
   
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq3.Name <> "BQ3" Then
 
    If Dir(chemin & "\" & bq3.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq3.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(11, 8).Value = pomme
        Cells(11, 9).Value = poire
        Cells(11, 10).Value = fraise
        Cells(11, 11).Value = raisin
        Cells(11, 12).Value = orange
        Cells(11, 13).Value = mandarine
        Cells(11, 14).Value = abricot

        If Sheets("Parametrage").Range("D6").Value = "AAA" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "BBB" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "CCC" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "DDD" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D6").Value = "EEE" Then

                ThisWorkbook.Sheets(bq3.Name).Activate

                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
   
     Else
   
        MsgBox (bq3.Name & " est introuvable")
   
     End If
             
End If
   
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq4.Name <> "BQ4" Then
   
    If Dir(chemin & "\" & bq4.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq4.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value

        ThisWorkbook.Sheets("PDF").Activate
 
        Cells(12, 8).Value = pomme
        Cells(12, 9).Value = poire
        Cells(12, 10).Value = fraise
        Cells(12, 11).Value = raisin
        Cells(12, 12).Value = orange
        Cells(12, 13).Value = mandarine
        Cells(12, 14).Value = abricot

            If Sheets("Parametrage").Range("D7").Value = "AAA" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "BBB" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "CCC" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "DDD" Then

                ThisWorkbook.Sheets(bq4.Name).Activate

                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If

            If Sheets("Parametrage").Range("D7").Value = "EEE" Then
           
                ThisWorkbook.Sheets(bq4.Name).Activate
               
                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
       
    Else
   
        MsgBox (bq4.Name & " est introuvable")
   
    End If
           
End If
   
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If bq35.Name <> "BQ35" Then
 
    If Dir(chemin & "\" & bq35.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt") <> "" Then
 
        txt_name = bq35.Name & " Etat des stocks par dépôt_" & jour & "_" & mois & "_" & annee & ".txt"
 
            If Len(Dir(chemin & "\" & txt_name)) = 0 Then
                Exit Sub
            End If
 
        Workbooks.OpenText Filename:=chemin & "\" & txt_name, _
                        DataType:=xlFixedWidth, StartRow:=13, Tab:=True
 
        pomme = Cells(1, 11).Value
        poire = Cells(5, 11).Value
        fraise = Cells(9, 11).Value
        raisin = Cells(13, 11).Value
        orange = Cells(17, 11).Value
        mandarine = Cells(21, 11).Value
        abricot = Cells(25, 11).Value
       
        ThisWorkbook.Sheets("PDF").Activate
       
        Cells(43, 8).Value = pomme
        Cells(43, 9).Value = poire
        Cells(43, 10).Value = fraise
        Cells(43, 11).Value = raisin
        Cells(43, 12).Value = orange
        Cells(43, 13).Value = mandarine
        Cells(43, 14).Value = abricot

            If Sheets("Parametrage").Range("D38").Value = "AAA" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(17, 3).Value = pomme
                Cells(17, 4).Value = poire
                Cells(17, 5).Value = fraise
                Cells(17, 6).Value = raisin
                Cells(17, 7).Value = orange
                Cells(17, 8).Value = mandarine
                Cells(17, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "BBB" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(18, 3).Value = pomme
                Cells(18, 4).Value = poire
                Cells(18, 5).Value = fraise
                Cells(18, 6).Value = raisin
                Cells(18, 7).Value = orange
                Cells(18, 8).Value = mandarine
                Cells(18, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "CCC" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(19, 3).Value = pomme
                Cells(19, 4).Value = poire
                Cells(19, 5).Value = fraise
                Cells(19, 6).Value = raisin
                Cells(19, 7).Value = orange
                Cells(19, 8).Value = mandarine
                Cells(19, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "DDD" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(20, 3).Value = pomme
                Cells(20, 4).Value = poire
                Cells(20, 5).Value = fraise
                Cells(20, 6).Value = raisin
                Cells(20, 7).Value = orange
                Cells(20, 8).Value = mandarine
                Cells(20, 9).Value = abricot
            End If
           
            If Sheets("Parametrage").Range("D38").Value = "EEE" Then
           
                ThisWorkbook.Sheets(bq35.Name).Activate
               
                Cells(21, 3).Value = pomme
                Cells(21, 4).Value = poire
                Cells(21, 5).Value = fraise
                Cells(21, 6).Value = raisin
                Cells(21, 7).Value = orange
                Cells(21, 8).Value = mandarine
                Cells(21, 9).Value = abricot
            End If
 
        Workbooks(2).Close (False)
     
     Else
   
        MsgBox (bq35.Name & " est introuvable")
   
     End If
         
End If

Worksheets("PDF").Visible = False
 
End Sub

Staple1600 · 3 Juin 2023

Bonjour @guiyom , le fil

Puisque que tu disposes d'Office 366, tu pourrais utiliser PowerQuery pour "combiner" tes N fichiers *txt dans ton classeur Excel.
(Pas besoin de VBA, se manipule à la souris, et la requête créé est actualisable)

Tu peux joindre un exemple simplifié et anonymisé de ton classeur Excel et d'un fichier *.txt ?
(en les mettant tous les deux dans un fichier Zip)

Cousinhub · 3 Juin 2023

Bonjour,
Je ne peux que plussoyer aux propos de JM, surtout que tu disposes de la version "année bissextile"...

Staple1600 à dit:
Bonjour @guiyom , le fil

Puisque que tu disposes d'Office 366,

Bonne journée

Gégé-45550 · 3 Juin 2023

Cousinhub à dit:
Bonjour,
Je ne peux que plussoyer aux propos de JM, surtout que tu disposes de la version "année bissextile"...

Puisque que tu disposes d'Office 366

Tout augmente

Cordialement à tous

Staple1600 · 3 Juin 2023

Bonjour messieurs

Que celui qui n'a jamais ripper sur son clavier me lance le premier ripp

En attendant les fichiers, je retourne me fader les ailes tristes de la destinée.
(mais version studio)

Gégé-45550 · 3 Juin 2023

Staple1600 à dit:
Bonjour messieurs

Que celui qui n'a jamais ripper sur son clavier me lance le premier ripp

En attendant les fichiers, je retourne me fader les ailes tristes de la destinée.
(mais version studio)

No pb l'ami, on l'a tous fait ... et plus souvent qu'à notre tour, c'était juste pour sourire (il paraît qu'il faut le faire au moins une fois par jour) et ça n'avait rien de personnel, bien au contraire !
Toutes mes excuses si ce joke t'a blessé !

Staple1600 · 3 Juin 2023

Re

@Gégé-45550
Je vois que tu n'as pas cliqué sur le lien dans mon message.
Celui-ci étant censé indiquer que je suis dans le registre de l'humour

D'un autre côté, si tu n'aimes pas le cuir, et les clous, tu auras épargné tes yeux

NB: Observe le titre de ce qui passera entre tes oreilles quand tu cliqueras sur le lien
Et tu comprendras (j'espère le trait d'humour)

En attendant, le demandeur a du abusé de la poire, au point d'être tombé dans les pommes.

Gégé-45550 · 3 Juin 2023

Staple1600 à dit:
Re

@Gégé-45550
Je vois que tu n'as pas cliqué sur le lien dans mon message.
Celui-ci étant censé indiquer que je suis dans le registre de l'humour
D'un autre côté, si tu n'aimes pas le cuir, et les clous, tu auras épargné tes yeux

NB: Observe le titre de ce qui passera entre tes oreilles quand tu cliqueras sur le lien
Et tu comprendras (j'espère le trait d'humour)

En attendant, le demandeur a du abusé de la poire, au point d'être tombé dans les pommes.

Priest aurait du s'appeler Jack plutôt que Judas ! ... et, d'accord, le cuir et les clous, c'est pas trop mon truc.
Bien amicalement,

mapomme · 3 Juin 2023

Bonsoir à tous

,

Encore un autre doigt fourchu de @Staple1666

et on passe d'Office 366 à 666. Et là c'est une tout autre histoire car si le diable vient se mêler à Judas et au prêtre, il va falloir redouter les pire malheurs précurseurs de l’apocalypse

.

nota : il est tout mimi le Rob Halford avec ces clous tout partout

.

Staple1600 · 3 Juin 2023

Bonjour @mapomme

Comment passer d'un panier de fruits, au doigt malhabile à l'Antéchrist de pacotille pour finir sur ce chef d'oeuvre de 65 moins deux ?
Je me le demande encore

Et si en plus on ajoute le chat flatulant dans le Range pour rester dans le theme Excel

Il est plus temps que guiyom revienne avec des fichiers exemples pour qu'enfin on fasse de l'Excel (avec ou sans clous)

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Réduire la taille de la macro ?

guiyom

XLDnaute Junior

Staple1600

XLDnaute Barbatruc

Cousinhub

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums