Amélioration de programme

Amélioration de programme - VB/VBA/VBS - Programmation

Marsh Posté le 30-04-2013 à 16:25:23    

Bonjour les amis voilà avec l'aide et les suggestions de code de beaucoup d'entre vous j'ai enfin teminé la programmation d'une macro servant à un tri de données . je vous laisse regarder mon code et si vous voyez une quelconque simplification n'hésitez pas .  
 

Code :
  1. Sub PMI()
  2. '##############Définition des colonnes en format dates#####################
  3. Dim i As Long
  4. Dim stock As Date
  5. fin = Range("A3" ).End(xlDown).Row
  6. '##############Définition des colonnes en format dates#####################
  7. Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
  8. Columns("F" ).NumberFormat = "General"
  9. '###############Transformation de la périodicité en jours##################
  10. For i = 3 To fin
  11.     Cells(i, 6).Select
  12.     If Cells(i, 6).Value = "4 Ans" Then
  13.     Cells(i, 6).Value = "1460"
  14.     End If
  15.     If Cells(i, 6).Value = "3 Ans" Then
  16.     Cells(i, 6).Value = "1095"
  17.     End If
  18.     If Cells(i, 6).Value = "2 Ans" Then
  19.     Cells(i, 6).Value = "730"
  20.     End If
  21.     If Cells(i, 6).Value = "1 Ans" Then
  22.     Cells(i, 6).Value = "365"
  23.     End If
  24.     If Cells(i, 6).Value = "18 Mois" Then
  25.     Cells(i, 6).Value = "548"
  26.     End If
  27.     If Cells(i, 6).Value = "6 Mois" Then
  28.     Cells(i, 6).Value = "183"
  29.     End If
  30.     If Cells(i, 6).Value = "4 Mois" Then
  31.     Cells(i, 6).Value = "122"
  32.     End If
  33. Next i
  34. '############### Réécriture de la date prochaine ##################
  35. For i = 3 To fin
  36.         Cells(i, 5).Select
  37.         Cells(i, 4).Select
  38.         Cells(i, 6).Select
  39.         If Cells(i, 5).Value = "-" Then
  40.         Cells(i, 5).Value = Application.Sum(Cells(i, 4).Value, Cells(i, 6).Value)
  41.         End If
  42. Next i
  43. '############### Définition de l'intervalle de travail ##################
  44.     Const PR = vbLf & vbLf & "Entrer la date de ", TI = "   INTERVALLE"
  45.     Dim DateDebut As Date, DateFin As Date, Dstock As Date
  46.     D = InputBox(PR & "début  :", TI, "01/01/" & Year(Now))
  47.     If IsDate(D) Then DateDebut = D Else Exit Sub
  48.     D = InputBox(PR & "fin  :", TI, D):  If IsDate(D) Then DateFin = D
  49.     If DateFin < DateDebut Then Beep: Exit Sub
  50.     Application.ScreenUpdating = False
  51.     For R = Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1
  52.         If IsDate(Cells(R, 5)) Then
  53.             Dstock = Cells(R, 5)
  54.             If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
  55.         End If
  56.     Next
  57.     Application.ScreenUpdating = True
  58. End sub


Message édité par sadhya le 30-04-2013 à 16:27:01
Reply

Marsh Posté le 30-04-2013 à 16:25:23   

Reply

Marsh Posté le 30-04-2013 à 19:17:03    

 
           (Re) Bonjour !
 
           Les déclarations de constantes et de variables doivent se situer en début de procédure (lignes n°49 & 50).
 
           Dans la supposition d'un devoir, ne connaissant pas les tenants & aboutissants de son énoncé ni ses imposés,
           en vue de n'utiliser qu'une seule et unique boucle pour cette procédure, voici des questions appelant chacune une réponse :
 
           1)  L'exécution de la procédure s'effectue-elle toujours au sein de la même feuille ?
                Dans l'affirmative, les lignes n°7 à 9 n'ont pas lieu d'être car, par raison d'efficacité / rapidité,
                il est préférable de faire la mise en forme des colonnes directement dans la feuille une fois pour toutes …
 
           2)  Pourquoi les boucles des lignes n°12 & 38 commencent à 3 tandis que celle de la ligne n°57 à 2 ?
 
           3)  Pourquoi les valeurs modifiant la sixième colonne entre les lignes n°15 & 33 sont-elles en format texte
                (entre guillemets donc) alors qu'elles sont censées représenter des jours ?
 
           4)  A quoi servent les lignes n°13 et 39 à 41 ?
 
           5)  Y a-t-il une raison particulière quant à l'écriture de l'addition de la ligne n°43 au lieu d'un simple E = D + F ?
 
           6)  Ne serait-il pas plus logique de commencer la procédure par demander l'intervalle de dates avant toute autre opération ?
 
           7)  La désactivation de la mise à jour de l'écran (ligne n°56) pour être efficace doit se situer avant toute modification de la feuille …
                Où devrait-elle donc être placée ?
 
           8)  Es-tu sûre du "1 ans" (donc avec un s !) de la ligne n°23 ?
 
           9)  Es-tu sûre de la valeur 548 de la ligne n°27 ?                  Car, si ce n'est pas une valeur arbitraire, chez moi  30.5 x 18 = 549 …


Message édité par Marc L le 30-04-2013 à 20:00:46
Reply

Marsh Posté le 30-04-2013 à 20:12:05    

Re-Bonjour Marc L, Ce code est l'une des requêtes que je dois effectuer dans le cadre de mon stage de fin de DUT . Donc elle servira au chef de mon entreprise d'acceuil  
 
1) Oui elle se fait dans une même feuille, dans le cadre de mon stage de fin de formation je dois proposer une solution informatique à mon tuteur donc une fois qu'il a copié ces données il touche à rien à part exécuter la macro et comme j'ai remarqué que ce n'est pas définit automatiquement bha j'ai essayé de prendre les devant
 
2) erreur de ma part j'ai rajouté une mise en page et j'ai oublié de changer cet indice
 
3) Je peux écraser le texte par des valeurs numériques ? si oui j'enlèverais les guillemets
 
4) Encore novice dans ce domaine dans ce que j'avais compris je croyais que c'était indispensable pour utiliser une cellule mais je les ai oté car plusieurs internautes m'ont fait remarquer que ça ralentis mon programme.
 
5) J'avais mis ça et j'avais remarqué qu'à certaine ligne ça n'effectuait pas l'addition  :(  
 
6) Oui effectivement ça serait mieux si je le mettais après les déclarations de variables  
 
7) Ok. Je la placerais Ligne 6 alors ...  
 
8) Ce sont des données prédéfinies par le constructeur je les récupère donc ainsi  
 
9) Ok je modifierais  
 
Merci beaucoup Marc L  :D  :D  :D


Message édité par sadhya le 30-04-2013 à 20:23:35
Reply

Marsh Posté le 01-05-2013 à 01:14:08    

 
            1)  Ok mais ce n'est plus utile une fois les colonnes déjà formatées …
 
            2)  Et donc lequel est le bon ?
 
            3)  Oui et de toute manière la colonne est au format standard, acceptant donc n'importe quel type de données …
                 Tout le bloc des lignes n°13 à 33 peut être simplifié par une structure  Select Case
                 ou encore mieux en seulement deux lignes par calcul grâce aux réponses des points 8 & 9) !
 
            5)  C'était peut-être avant le formatage des colonnes, sinon pas de souci …
 
            7)  Oui !
 
            8 & 9)  Ok et cela m'arrange pour le point 3) !  
 
            Pas disponible dans la journée, la suite dans la soirée ou le lendemain, le temps de tester de ton côté,
            la procédure sera en fait assez proche du code précédent ...


Message édité par Marc L le 01-05-2013 à 01:35:42
Reply

Marsh Posté le 01-05-2013 à 16:53:34    

Salut Marc L ,  
 
Génial ça fonctionne voici le code :  

Code :
  1. Sub PMI()
  2. '##############Définition des colonnes en format dates#####################
  3. Dim i As Long
  4. Dim stock As Date
  5. fin = Range("A3" ).End(xlDown).Row
  6. Const PR = vbLf & vbLf & "Entrer la date de ", TI = "   INTERVALLE"
  7. Dim DateDebut As Date, DateFin As Date, Dstock As Date
  8. D = InputBox(PR & "début  :", TI, "01/01/" & Year(Now))
  9. Application.ScreenUpdating = False
  10. '##############Définition des colonnes en format dates#####################
  11. Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
  12. Columns("F" ).NumberFormat = "General"
  13. '###############Transformation de la périodicité en jours##################
  14. For i = 3 To fin
  15.    Select Case Cells(i, 6).Value
  16.           Case "4 Ans"
  17.                 Cells(i, 6).Value = 1460
  18.           Case "3 Ans"
  19.                 Cells(i, 6).Value = 1095
  20.           Case "2 Ans"
  21.                 Cells(i, 6).Value = 730
  22.           Case "1 Ans"
  23.                 Cells(i, 6).Value = 365
  24.           Case "18 Mois"
  25.                 Cells(i, 6).Value = 549
  26.           Case "6 Mois"
  27.                 Cells(i, 6).Value = 183
  28.           Case "4 Mois"
  29.                 Cells(i, 6).Value = 122
  30.     End Select
  31. Next i
  32. '############### Réécriture de la date prochaine ##################
  33. For i = 3 To fin
  34.         If Cells(i, 5).Value = "-" Then
  35.         Cells(i, 5).Value = Cells(i, 4).Value + Cells(i, 6).Value
  36.         End If
  37. Next i
  38. '############### Définition de l'intervalle de travail ##################
  39.    
  40.     If IsDate(D) Then DateDebut = D Else Exit Sub
  41.     D = InputBox(PR & "fin  :", TI, D):  If IsDate(D) Then DateFin = D
  42.     If DateFin < DateDebut Then Beep: Exit Sub
  43.    
  44.     For R = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1
  45.         If IsDate(Cells(R, 5)) Then
  46.             Dstock = Cells(R, 5)
  47.             If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
  48.         End If
  49.     Next
  50.     Application.ScreenUpdating = True
  51. End Sub


 
Je rencontre un autre problème voilà j'effectue une autre commande mais elle est trop conséquente pour excel ça plante ça ne la termine jamais voici :  
 

Code :
  1. Sub Retardpmi()
  2. Dim wkb As Workbook: Set wkb = ThisWorkbook
  3. ligne2 = 3
  4. With wkb
  5.   Dim sht1 As Worksheet: Set sht1 = Worksheets("Feuil1" )
  6.   Dim sht2 As Worksheet: Set sht2 = Worksheets("Feuil2" )
  7.   Dim sht3 As Worksheet: Set sht3 = Worksheets("Feuil3" )
  8. End With
  9. Application.ScreenUpdating = False
  10. With sht2 ' Feuille 2
  11. fin = Range("A1" ).End(xlDown).Row
  12. fin1 = sht3.Range("A1" ).End(xlDown).Row
  13.   For ligne = 3 To fin
  14.      For ligne1 = 3 To fin1
  15.    ' Si cellule Feuil1 <> Feuil2
  16.    If Not (.Cells(ligne, 2) = sht3.Cells(ligne1, 2)) Then
  17.      ' cel Feuil2 prend la valeur Cel Feuil1
  18.     .Rows(ligne).Copy sht1.Rows(ligne2)
  19.     ligne2 = ligne2 + 1
  20.    End If
  21.   Next ligne1
  22.   Next ligne
  23. End With
  24.   Application.ScreenUpdating = True
  25. End Sub


 As tu des propositions à me faire ?


Message édité par sadhya le 01-05-2013 à 16:54:31
Reply

Marsh Posté le 02-05-2013 à 02:13:25    

 
           Pas mal !
 
           Voici mon code en une boucle unique et le calcul de la périodicité :  

Code :
  1. Sub PMI()
  2.     Const PR = vbLf & vbLf & "Entrer la date de ", TI = "   INTERVALLE"
  3.     Dim DateDebut As Date, DateFin As Date, Dstock As Date
  4.  
  5. '   Définition de l'intervalle de travail
  6.     D = InputBox(PR & "début  :", TI, "01/01/" & Year(Now))
  7.     If IsDate(D) Then DateDebut = D Else Exit Sub
  8.     D = InputBox(PR & "fin  :", TI, D):  If IsDate(D) Then DateFin = D
  9.     If DateFin < DateDebut Then Beep: Exit Sub
  10.     Application.ScreenUpdating = False
  11.  
  12. '   Définition des formats de colonnes
  13. '    Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
  14. '      Columns("F" ).NumberFormat = "General"
  15.  
  16.     For R = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1
  17. '       Transformation de la périodicité en jours
  18.          If InStr(Cells(R, 6), "Ans" ) Then Cells(R, 6) = Val(Cells(R, 6)) * 365 Else _
  19.         If InStr(Cells(R, 6), "Mois" ) Then Cells(R, 6) = Val(Cells(R, 6)) * 30.5
  20.  
  21. '       Réécriture de la date prochaine
  22.         If Cells(R, 5) = "-" And IsDate(Cells(R, 4)) And IsNumeric(Cells(R, 6)) Then _
  23.            Cells(R, 5) = CDate(Cells(R, 4)) + Cells(R, 6)
  24.  
  25. '       Suppression des lignes hors intervalle
  26.         If IsDate(Cells(R, 5)) Then Dstock = Cells(R, 5) Else Dstock = 0
  27.         If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
  28.     Next
  29.  
  30.     Application.ScreenUpdating = True
  31. End Sub

           ► Les propriétés  Cells  et  Range  seules représentent la valeur d'une cellule.
               Mais, face à un puriste et dans un souci de code homogène, mieux vaut ne pas oublier de bien les qualifier par  .Value  …
 
           ► Ligne n°16 :  la dernière ligne traitée correspond à celle de la dernière saisie de la cinquième colonne.
                                   Mais s'il y avait d'autres données en dessous avec des cellules vides dans cette colonne E,
                                   cela pourrait faire désordre !   Vaudrait mieux alors se pencher sur la propriété  UsedRange  …
 
           ► Ligne n°22 :  afin d'éviter de reproduire ton souci d'origine de cohérence, mieux vaut contrôler les cellules avant l'addition …
                                   La fonction  Sum  s'affranchit du souci de cohérence de formats / valeurs mais son résultat en est erroné.
 
           ► Variation pour la suppression d'une ligne :  si la cellule dans la cinquième colonne n'est pas une date, la ligne est effacée.
 
           ______________________________________________________________________________________________________
 
           Quant à ta nouvelle procédure, non pas seulement à cause de l'heure tardive mais par complément d'information,
           même si je me doute du problème, avant de souligner une méchante erreur de conception / logique.
 
           Merci de la poster dans un nouveau sujet car c'est une nouvelle problématique …
 
           … tout en expliquant précisément ce qu'elle est censée faire, le message d'erreur et la ligne déclenchant l'erreur.


Message édité par Marc L le 02-05-2013 à 02:54:55
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed