Comment simplifier mon code

D

daniel_c

XLDnaute Nouveau
Bonjour le forum

Je viens vers vous pour trouvez assistance pour le code présent en pièce jointe.

J'ai diminué le nombre de feuilles de mon classeur afin de pouvoir le mettre en pièce jointe.

Mon classeur réel me permet de gérer des stocks voitures, il est constitué de de 109 feuilles: 2 feuilles pour chacun des 54 stocks plus une feuille de synthèse.

Les feuilles Tx donnent l'état des stocks voitures.

Les feuilles mvtTx donnent les mouvements des pièces des stocks voitures.

Dans les feuilles Tx je récupére les données des feuilles mvtTx pour calculer les stocks agés avec le code:

Code: 
Sheets("T07").Select
With Sheets("T07")
e = Range("A65536").End(xlUp).Row
Application.DisplayAlerts = False
Range("L3:L" & e) = "=IF(COUNTIF(mvtT07!C[-11],RC[-11])=0,""Pas d'entrée"",INDEX(mvtT07!C[-8],MATCH(RC[-11],mvtT07!C[-11],0),1))"
Range("M3:M" & e) = "=IF(COUNTIF(mvtT07!C[-12],RC[-12])=0,""Pas de sortie"",INDEX(mvtT07!C[-8],MATCH(RC[-12],mvtT07!C[-12],0),1))"
Range("N3:N" & e) = "=IF(AND(RC[-2]=db!R2C6,RC[-1]=db!R3C6),RC[-3],"""")"
Application.DisplayAlerts = True
Range("L:L,M:M").Select
Selection.NumberFormat = "m/d/yyyy"
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
Range("M1").NumberFormat = "0"
Range([J3], [N3].End(xlDown)).Copy
Range([J3], [N3].End(xlDown)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("O:O").Delete
Range("A1").Select
End With

Je répéte ce code pour chacun des 54 stocks voitures

Le code est trés long, de plus le volume des données à traiter fait qu'Excel plante par manque de mémoire :mad:

L'ensemble des feuilles mvtTx représente ~25000 lignes
L'ensemble des feuilles Tx représente ~5500 lignes

Est-il possible de modifier ce code pour le rendre plus court et surtout pour éviter qu'Excel plante. :confused:

Merci pour votre aide

Daniel
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment simplifier mon code

Bonjour


Un premier essai

Code: 
With Sheets("T07")
    e = .Range("A65536").End(xlUp).Row
    Application.DisplayAlerts = False
    .Range("L3:L" & e) = "=IF(COUNTIF(mvtT07!C[-11],RC[-11])=0,""Pas d'entrée"",INDEX(mvtT07!C[-8],MATCH(RC[-11],mvtT07!C[-11],0),1))"
    .Range("M3:M" & e) = "=IF(COUNTIF(mvtT07!C[-12],RC[-12])=0,""Pas de sortie"",INDEX(mvtT07!C[-8],MATCH(RC[-12],mvtT07!C[-12],0),1))"
    .Range("N3:N" & e) = "=IF(AND(RC[-2]=db!R2C6,RC[-1]=db!R3C6),RC[-3],"""")"
    Application.DisplayAlerts = True
    With .Range("L:L,M:M") 'ici tu prends toutes les cellules des colonnes  hummm
    .NumberFormat = "m/d/yyyy"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    End With
    .Range("M1").NumberFormat = "0"
    With .Range([J3], [N3].End(xlDown))
    .Value = .Value
    End With
    .Columns("O:O").Delete
End With
et en ajoutant

Application.ScreenUpdating=False en début de code aussi
 
Vote positif 0 Vote négatif
J

jp14

XLDnaute Barbatruc
Re : Comment simplifier mon code

Bonjour daniel_c
Bonsoir Staple1600

Une autre approche en utilisant une macro paramétrable
Code: 
Sub essai(nomfeuille As String, nommouvement As String)
Sheets(nomfeuille).Select
With Sheets(nomfeuille)
e = Range("A65536").End(xlUp).Row
Application.DisplayAlerts = False
Range("L3:L" & e) = "=IF(COUNTIF(" & nommouvement & "!C[-11],RC[-11])=0,""Pas d'entrée"",INDEX(mvtT07!C[-8],MATCH(RC[-11],mvtT07!C[-11],0),1))"
Range("M3:M" & e) = "=IF(COUNTIF(" & nommouvement & "!C[-12],RC[-12])=0,""Pas de sortie"",INDEX(mvtT07!C[-8],MATCH(RC[-12],mvtT07!C[-12],0),1))"
Range("N3:N" & e) = "=IF(AND(RC[-2]=db!R2C6,RC[-1]=db!R3C6),RC[-3],"""")"
Application.DisplayAlerts = True
Range("L:L,M:M").Select
Selection.NumberFormat = "m/d/yyyy"
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
Range("M1").NumberFormat = "0"
Range([J3], [N3].End(xlDown)).Copy
Range([J3], [N3].End(xlDown)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("O:O").Delete
Range("A1").Select
End With
End Sub

' appel de la procédure

call essai(nomfeuille:="T07", nommouvement:="mvtT07")

call essai(nomfeuille:="Tx", nommouvement:="mvtTx")


JP
 
Vote positif 0 Vote négatif
D

daniel_c

XLDnaute Nouveau
Re : Comment simplifier mon code

Bonjour Staple1600, le forum

Ton pseudo m'évoque une référence d'agrafe familière :D

Merci pour la simplification du code sur la partie mise en forme

Pour la partie formules:

Code: 
Range("L3:L" & e) = "=IF(COUNTIF(mvtT07!C[-11],RC[-11])=0,""Pas d'entrée"",INDEX(mvtT07!C[-8],MATCH(RC[-11],mvtT07!C[-11],0),1))"
Range("M3:M" & e) = "=IF(COUNTIF(mvtT07!C[-12],RC[-12])=0,""Pas de sortie"",INDEX(mvtT07!C[-8],MATCH(RC[-12],mvtT07!C[-12],0),1))"
Range("N3:N" & e) = "=IF(AND(RC[-2]=db!R2C6,RC[-1]=db!R3C6),RC[-3],"""")"

est il possible de créer une boucle type FOR....NEXT qui permettrait de remplacer les reférences aux stocks et mouvements, par exemple

Tx fait reference à T07, T13.....ect

mvtTx fait référence à mvtT07, mvtT13.....ect

cela permettrait-il de préserver les resources mémoire ????

Cordialement
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment simplifier mon code

Re


Voir la réponse de jp14


Sur cette partie du code:
Code: 
With .Range("L:L,M:M") 'ici tu prends toutes les cellules des colonnes  hummm
    .NumberFormat = "m/d/yyyy"
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    End With

Est-il utile d'appliquer le format à l'ensemble des cellules ?

Cela alourdit ton classeur.

Il faudrait identifier la dernière cellule utile de ces colonnes
 
Vote positif 0 Vote négatif
D

daniel_c

XLDnaute Nouveau
Re : Comment simplifier mon code

Bonjour JP14, Staple1600, le forum

JP14, tu anticipes ma demande :)

si j'ai bien compris je rentre le code générique (partie haute)

puis je crée une procédure pour chacun des 54 stocks voitures

un détail m'interpelle, les appels de procédures se place aprés le End Sub ????

les appels de procédures seront lancés automatiquement lorsque je clique sur le bouton faisant référence au code "essai" ????

Mes question mettent en evidence mes faibles connaissances en VBA :rolleyes:

Pourrais tu me mettres le code dans le fichier test si je m'égare

Merci
 
Vote positif 0 Vote négatif
D

daniel_c

XLDnaute Nouveau
Re : Comment simplifier mon code

Bonjour JP14, Staple1600, le forum

Je crois que je n'ai pas tout compris

Je mets le code dans un module, mais comment je le lance ?

ps;;;quelques complements de modif sur le code

Code: 
Sub essai(nomfeuille As String, nommouvement As String)
Sheets(nomfeuille).Select
With Sheets(nomfeuille)
e = Range("A65536").End(xlUp).Row
Application.DisplayAlerts = False
Range("L3:L" & e) = "=IF(COUNTIF(" & nommouvement & "!C[-11],RC[-11])=0,""Pas d'entrée"",INDEX(" & nommouvement & "!C[-8],MATCH(RC[-11]," & nommouvement & "!C[-11],0),1))"
Range("M3:M" & e) = "=IF(COUNTIF(" & nommouvement & "!C[-12],RC[-12])=0,""Pas de sortie"",INDEX(" & nommouvement & "!C[-8],MATCH(RC[-12]," & nommouvement & "!C[-12],0),1))"
Range("N3:N" & e) = "=IF(AND(RC[-2]=db!R2C6,RC[-1]=db!R3C6),RC[-3],"""")"
Application.DisplayAlerts = True
Range("L:L,M:M").Select
Selection.NumberFormat = "m/d/yyyy"
   With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
Range("M1").NumberFormat = "0"
Range([J3], [N3].End(xlDown)).Copy
Range([J3], [N3].End(xlDown)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("O:O").Delete
Range("A1").Select
End With
End Sub
' appel de la procédure
Call essai(nomfeuille:="T07", nommouvement:="mvtT07")
Call essai(nomfeuille:="T13", nommouvement:="mvtT13")

Un peu d'aide svp


Daniel
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Comment simplifier mon code

Re

Comme ceci
Code: 
sub appelprocs()
Call essai(nomfeuille:="T07", nommouvement:="mvtT07")
Call essai(nomfeuille:="T13", nommouvement:="mvtT13")
end sub
ou comme cela
Code: 
sub appelp()
essai "T07", "mvtT07"
essai "T13", "mvtT13"
end sub
 
Dernière édition:
Vote positif 0 Vote négatif
J

jp14

XLDnaute Barbatruc
Re : Comment simplifier mon code

Bonjour daniel_c, Staple1600, le forum

Ci dessous une procédure pour lancer la macro paramétrable.
Code: 
Sub essai1()
Dim pos As Byte
Dim pos1 As Byte
Dim val1 As Integer
 Dim Sh As Worksheet
     For Each Sh In Worksheets
     pos = InStr(Sh.Name, "T0") '
     pos1 = InStr(Sh.Name, "mvt")
         If pos > 0 And pos1 = 0 Then ' le fichier contient le préfixe TO et pas mvt
            val1 = CInt(Replace(Sh.Name, "T0", ""))
            Call essai(nomfeuille:="T0" & val1, nommouvement:="mvtT0" & val1)
        End If
     Next Sh

End Sub

On recherche les feuilles qui ont le préfixe T0.

A tester

JP
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne
S
  • Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
486
Staple1600
Staple1600
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
176
souhaib ad
S
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
443
Dranreb
Dranreb
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
126
AtTheOne
AtTheOne
P
  • Question
Microsoft 365 Problème de destination à l'exécution d'une macro
Réponses
2
Affichages
305
Pimpon974
P
G
  • Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
648
Staple1600
Staple1600
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
T
  • Résolu(e)
XL 2019 VBA - Comparaison d'heures
Réponses
9
Affichages
262
ThierryP
T
H
  • Question
Autres mise a jour automatique feuille excel vba
Réponses
2
Affichages
321
HANN
H

Membres actuellement en ligne

17 membres et 115 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 489
Messages
2 088 868
Membres
103 980
dernier inscrit
grandmasterflash38