[Résolu] optimisation de macro

G

Gilles52300

XLDnaute Junior
Bonjour,
j'ai crée ces macros, mais je pense qu'il est possible de les optimiser car je fais beaucoup de répétition.
Aussi j'aurais besoin de vos connaisances pour savoir si c'est possible et surtout comment faire car je n'arrive pas à trouver.
merci pour votre aide.
Les macros sont sur les modules 4 et 6.
je vous joints mon fichier en pièce jointe.
 

Pièces jointes

  • 2013 classeur béton (BETA3).xlsm
    162.6 KB · Affichages: 87
Dernière édition:
Trier par date Trier par votes
G

Gilles52300

XLDnaute Junior
Re : [Résolu] optimisation de macro

Bonjour Martial,

Voici un petit problème auquel je suis confronté. Cela se tient dans la partie cité du code qui tel qu'il est fonctionne très bien. Je voudrais juste éviter une erreur qui pourrait se produire.

Par ce code, je cherche le Nbre de ligne qui ont le même N° de rapport. Les N° de rapport sont toujours contigus. Je voudrais que "ii" corresponde à ligne du premier N° de rapport dans la liste.
ex:
N° de ligne contigue contenant les rapport 4;5;6;7;8;9
si je tape 6 dans l'inputbox soit "ii" = 6, je voudrais que "ii"récupère l'info de la première ligne donc que "ii"=4
j'espère avoir été assez clair!

merci de ton aide.

'on rentre la ligne du rapport à saisir
ii = InputBox("Ligne de rapport", "Saisie")
'on vérifie le nombre de ligne avec le même numéro de rapport
With Sheets("Carnet").Select
vrecherche = Range("E" & ii)
xx = Application.CountIf(Range("E4:E3000"), vrecherche)
End With
Cliquez pour agrandir...

Code: 
Sub rapport()
'pour la mise en page du rapport d'écrasement et impression pdf dans un classeur
'en fonction des clients.

Dim ii As Integer, xx As Byte, vrecherche As Variant
Dim My As Integer

'voir pour pour lancer l'impression
'rajouter une colonne sur la feuille pour indiquer que le rapport est imprimé.

'on rentre la ligne du rapport à saisir
    ii = InputBox("Ligne de rapport", "Saisie")
'on vérifie le nombre de ligne avec le même numéro de rapport
    With Sheets("Carnet").Select
        vrecherche = Range("E" & ii)
        xx = Application.CountIf(Range("E4:E3000"), vrecherche)
    End With
'saisie des informations de base
With Sheets("rapport").Select
'information N° de rapport
    Range("H4") = vrecherche
'information client
    Range("C4") = Sheets("Carnet").Range("B" & ii)
'information Lieu
    Range("C5") = Sheets("Carnet").Range("T" & ii)
'information Ouvrage
    Range("C6") = Sheets("Carnet").Range("U" & ii)
'information partie ouvrage
    Range("C7") = Sheets("Carnet").Range("V" & ii)
'information date prelevement
    Range("C10") = Sheets("Carnet").Range("F" & ii) - 0
'information date de  réception
    Range("I10") = Sheets("Carnet").Range("C" & ii) - 0
'information Serrage
    Range("C11") = Sheets("Carnet").Range("H" & ii)
'information eprouvette réalisé par
    Range("I11") = Sheets("Carnet").Range("I" & ii)
        'information Affaissement fixé par la formule
            'Range("C12") = Sheets("Carnet").Range("W" & ii) & " Cm"
        'information Volume de béton mis en œuvre
            'sheets("rapport").Range("I12") = sheets("Carnet").Range("A" & ii)
'information lieu de confection
    Range("C13") = Sheets("Carnet").Range("J" & ii)
'information Mode de conservation
    Range("C14") = "EAU THERMOSTÉE A 20°C SELON LA NORME NF EN 12390-2"
'information le Type de moule utilisé
    If Sheets("Carnet").Range("G" & ii) = 1 Then
            Range("H15") = "Ø 15 x 30"
        ElseIf Sheets("Carnet").Range("G" & ii) = "2" Then
            Range("H15") = "Ø 15,8 x 31,8"
        Else
            Range("H15") = Sheets("Carnet").Range("G" & ii)
    End If
Suite:
        'information méthode de préparation des faces d'appui
            'sheets("rapport").Range("E16") = sheets("Carnet").Range("A" & ii)
'information Producteur
    Range("C20") = Sheets("Carnet").Range("AC" & ii)
'information Appelation béton
    Range("C21") = Sheets("Carnet").Range("S" & ii)
'information écrasée par
    Range("B24") = Sheets("Carnet").Range("AB" & ii)
'information date d'écrasement
    Range("E24") = Sheets("Carnet").Range("O" & ii) - 0
'information age du béton
    Range("H24") = Sheets("Carnet").Range("M" & ii) & " Jours."
'information nombre d'éprouvette confectionnée
    Range("E15") = xx
    Range("A26:G31").ClearContents
        My = 0
        j = 25
        xx = ii + xx - 1
        For ii = ii To xx
            j = j + 1
'information N° d'éprouvette geotechsol
            Range("A" & j) = Sheets("Carnet").Range("A" & ii)
'information N° d'éprouvette Client
            Range("B" & j) = Sheets("Carnet").Range("K" & ii)
'information Affaissement
            Range("C" & j) = Sheets("Carnet").Range("W" & ii)
'information poids de l'éprouvette
            Range("D" & j) = Sheets("Carnet").Range("R" & ii)
'information M.V.A
            Range("E" & j) = Sheets("Carnet").Range("Y" & ii)
'information force de rupture
            Range("F" & j) = Sheets("Carnet").Range("X" & ii)
'information résistance Mpa
            Range("G" & j) = Sheets("Carnet").Range("Z" & ii)
            My = My + Range("G" & j)
        Next ii
'information moyenne Mpa
    Range("H26") = My / Range("E15")
    
 End With

End Sub
 
Vote positif 0 Vote négatif
G

Gilles52300

XLDnaute Junior
Re : [Résolu] optimisation de macro

Bon après plusieurs heures à chercher, j'ai fini par adopter cela mais honnêtement cela ne me plait pas trop.

car avec ce code que j'ai essayer dans tous les sens, c'est la dernière ligne que je trouve à chaque fois au lieu de la première.
est-ce qu'il n'y a pas une solution pour trouver la première ligne?
j'ai essayé avec .find mais sans succés. je lance et il ne me trouve "Nothing" alors que les doublons existent.

Code: 
'on rentre la ligne du rapport à saisir
    ii = InputBox("Ligne de rapport", "Saisie")
'on vérifie le nombre de ligne avec le même numéro de rapport
    With Sheets("Carnet").Select
        vrecherche = Range("E" & ii)
        xx = Application.CountIf(Range("E4:E3000"), vrecherche)
        
'Permet de récupérer la dernière ligne correspondant au N° de rapport saisie
            For yy = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
            If (Cells(yy, 5)) = vrecherche Then
'determine ii en fonction du calcul suivant. (pas beau)
            ii = Cells(yy, 5).Row - xx + 1
            MsgBox ii
            Exit For
            End If
            Next

    End With
 
Dernière édition:
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : [Résolu] optimisation de macro

Bonjour Gilles,

Je n'ai pas tout compris de ta demande, pourrais-tu remettre un fichier avec des valeurs en colonne E dans Carnet ?

Peut-être mettre aussi, en couleur, ce que tu as et ce que tu souhaites obtenir.

A+

Martial
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : [Résolu] optimisation de macro

Salut Gilles,

Voici un bout de macro te permettant de récupérer la 1ère ligne de ta référence :

VB: 
'on rentre la ligne du rapport ˆ saisir
ii = InputBox("Ligne de rapport", "Saisie")
For yy = ii To 4 Step -1
  If Cells(yy, 5) <> Cells(yy - 1, 5) Then Exit For
Next
    MsgBox "Voici la ligne " & yy

Ca doit le faire ?

A+

Martial
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : [Résolu] optimisation de macro

Sinon, avec le nombre de ligne correspondant à ta référence.

VB: 
'on rentre la ligne du rapport ˆ saisir
ii = InputBox("Ligne de rapport", "Saisie")
For yy = ii To 4 Step -1
  If Cells(yy, 5) <> Cells(yy - 1, 5) Then Exit For
Next
  MsgBox "Voici la ligne " & yy
xx = Application.CountIf(Range("E4:E3000"), Range("E" & yy))
  MsgBox "Voici le NB de ligne " & xx

A+

Martial
 
Vote positif 0 Vote négatif
G

Gilles52300

XLDnaute Junior
Re : [Résolu] optimisation de macro

Super génial. Merci bien.
Maintenant je vais me lancer dans l'impression de la feuille. mon soucis c'est que je travaille sous mac et que le programme va être utilisé sous windows. ils ont pdf creat sur le pc je vais voir si je peux l'inclure dans vba. sinon je prendrais pdf creator.
si tu as un code déjà prêt, je suis preneur.
Merci bien .
A+
Gilles
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : [Résolu] optimisation de macro

Re,

Voici un fichier sur lequel j'avais travaillé pour un autre participant.

A+

PS : Dans le fichier, il y a également pour l'envoyer par mail.
 

Pièces jointes

  • Mail OutLook seulement onglet actif pdf.xlsm
    17.8 KB · Affichages: 37
  • Mail OutLook seulement onglet actif pdf.xlsm
    17.8 KB · Affichages: 40
  • Mail OutLook seulement onglet actif pdf.xlsm
    17.8 KB · Affichages: 40
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : [Résolu] optimisation de macro

Bonjour Gilles, bonjour à tous,

J'ai ouvert ta discussion, mais je n'y connais pas grand chose en Mac.

Je ne réponds pas sur l'autre discussion car souvent les répondeurs ne regardent que les posts qui n'ont pas de réponse. Peut-être comme ceci :

VB: 
Sheets("rapport").Select 
 Chemin = "Macintosh OS:Users:gilles:Travail:Haiti:Chantiers:BETON:" & Range("C4")
 Fichier = Range("H4") & ".xls"               'c'est un numéro différent à chaque fois
 If Dir(Chemin, vbNormal) = "" Then MkDir Chemin
 ActiveWorkbook.SaveAs Chemin & ":" & Fichier

Sinon, peut-être dans les liens ci-dessous :

FAQ MS-Excel

Ce lien n'existe plus

Excel 2011 Mac - VBA - GetData (path)Excel 2011 Mac - VBA - GetData (path)
Il suffit de traduire avec Google.

A+

Martial
 
Vote positif 0 Vote négatif
G

Gilles52300

XLDnaute Junior
Re : [Résolu] optimisation de macro

Bonjour Martial,

J'ai fini par trouvé et j'ai posté la solution dans mon message initial. Lien supprimé
Dès fois que quelqu'un en ai besoin!
Bonne fin de dimanche et bon courage pour demain.
Moi je continue dans le perfectionnement de mon classeur.
mais à l'heure qu'il est, le plus gros est fait et fonctionne.
Un grand merci à toi.
Je me demande bien ce que je vais pouvoir trouver à faire quand j'aurais fini!!!!!!
A+
Gilles
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Analyses complémentaires optimisation production
Réponses
2
Affichages
236
mswin
M
J
  • Question
XL 2016 Optimisation SOMMEPROD (résolu)
Réponses
11
Affichages
437
tbft
tbft
T
  • Question
XL 2019 créer une toupie qui gère des couleurs ou des mots
Réponses
7
Affichages
308
thierry.09
T
C
  • Résolu(e)
XL 2021 Macro dans Macro
2
Réponses
26
Affichages
404
Constantin
C
F
  • Question
Microsoft 365 Copie de couleur de cellules
Réponses
3
Affichages
184
gbinforme
G
M
  • Question
XL 2021 Correction de test psychométrique automatisée
Réponses
4
Affichages
251
TooFatBoy
TooFatBoy
H
  • Question
XL 2016 Créer une méthode pour calculer les combinaisons entre beaucoup d'article
Réponses
1
Affichages
210
Katido
K
L
  • Résolu(e)
Microsoft 365 Optimisation d'un code avec boucle
Réponses
3
Affichages
186
Louloulou4
L
E
  • Résolu(e)
Microsoft 365 Optimisation de la RAM - Exploitation de fonction ou de procédure
Réponses
6
Affichages
334
elgringo123456
E
B
  • Résolu(e)
XL 2013 rapidité d une macro
Réponses
6
Affichages
333
bertilemeusien
B

Membres actuellement en ligne

9 membres et 57 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 294
Messages
2 086 906
Membres
103 404
dernier inscrit
sultan87