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
  7. '##############Définition des colonnes en format dates#####################
  8. Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
  9. Columns("F" ).NumberFormat = "General"
  11. '###############Transformation de la périodicité en jours##################
  12. For i = 3 To fin
  13.     Cells(i, 6).Select
  14.     If Cells(i, 6).Value = "4 Ans" Then
  15.     Cells(i, 6).Value = "1460"
  16.     End If
  17.     If Cells(i, 6).Value = "3 Ans" Then
  18.     Cells(i, 6).Value = "1095"
  19.     End If
  20.     If Cells(i, 6).Value = "2 Ans" Then
  21.     Cells(i, 6).Value = "730"
  22.     End If
  23.     If Cells(i, 6).Value = "1 Ans" Then
  24.     Cells(i, 6).Value = "365"
  25.     End If
  26.     If Cells(i, 6).Value = "18 Mois" Then
  27.     Cells(i, 6).Value = "548"
  28.     End If
  29.     If Cells(i, 6).Value = "6 Mois" Then
  30.     Cells(i, 6).Value = "183"
  31.     End If
  32.     If Cells(i, 6).Value = "4 Mois" Then
  33.     Cells(i, 6).Value = "122"
  34.     End If
  35. Next i
  37. '############### Réécriture de la date prochaine ##################
  38. For i = 3 To fin
  39.         Cells(i, 5).Select
  40.         Cells(i, 4).Select
  41.         Cells(i, 6).Select
  42.         If Cells(i, 5).Value = "-" Then
  43.         Cells(i, 5).Value = Application.Sum(Cells(i, 4).Value, Cells(i, 6).Value)
  44.         End If
  45. Next i
  47. '############### Définition de l'intervalle de travail ##################
  49.     Const PR = vbLf & vbLf & "Entrer la date de ", TI = "   INTERVALLE"
  50.     Dim DateDebut As Date, DateFin As Date, Dstock As Date
  52.     D = InputBox(PR & "début  :", TI, "01/01/" & Year(Now))
  53.     If IsDate(D) Then DateDebut = D Else Exit Sub
  54.     D = InputBox(PR & "fin  :", TI, D):  If IsDate(D) Then DateFin = D
  55.     If DateFin < DateDebut Then Beep: Exit Sub
  56.     Application.ScreenUpdating = False
  58.     For R = Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1
  59.         If IsDate(Cells(R, 5)) Then
  60.             Dstock = Cells(R, 5)
  61.             If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
  62.         End If
  63.     Next
  65.     Application.ScreenUpdating = True
  66. 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))
  10. Application.ScreenUpdating = False
  11. '##############Définition des colonnes en format dates#####################
  12. Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
  13. Columns("F" ).NumberFormat = "General"
  15. '###############Transformation de la périodicité en jours##################
  16. For i = 3 To fin
  17.    Select Case Cells(i, 6).Value
  18.           Case "4 Ans"
  19.                 Cells(i, 6).Value = 1460
  20.           Case "3 Ans"
  21.                 Cells(i, 6).Value = 1095
  22.           Case "2 Ans"
  23.                 Cells(i, 6).Value = 730
  24.           Case "1 Ans"
  25.                 Cells(i, 6).Value = 365
  26.           Case "18 Mois"
  27.                 Cells(i, 6).Value = 549
  28.           Case "6 Mois"
  29.                 Cells(i, 6).Value = 183
  30.           Case "4 Mois"
  31.                 Cells(i, 6).Value = 122
  32.     End Select
  33. Next i
  35. '############### Réécriture de la date prochaine ##################
  36. For i = 3 To fin
  37.         If Cells(i, 5).Value = "-" Then
  38.         Cells(i, 5).Value = Cells(i, 4).Value + Cells(i, 6).Value
  39.         End If
  40. Next i
  42. '############### Définition de l'intervalle de travail ##################
  43.    
  44.     If IsDate(D) Then DateDebut = D Else Exit Sub
  45.     D = InputBox(PR & "fin  :", TI, D):  If IsDate(D) Then DateFin = D
  46.     If DateFin < DateDebut Then Beep: Exit Sub
  47.    
  48.     For R = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1
  49.         If IsDate(Cells(R, 5)) Then
  50.             Dstock = Cells(R, 5)
  51.             If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
  52.         End If
  53.     Next
  55.     Application.ScreenUpdating = True
  57. 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()
  3. Dim wkb As Workbook: Set wkb = ThisWorkbook
  4. ligne2 = 3
  5. With wkb
  6.   Dim sht1 As Worksheet: Set sht1 = Worksheets("Feuil1" )
  7.   Dim sht2 As Worksheet: Set sht2 = Worksheets("Feuil2" )
  8.   Dim sht3 As Worksheet: Set sht3 = Worksheets("Feuil3" )
  9. End With
  10. Application.ScreenUpdating = False
  11. With sht2 ' Feuille 2
  12. fin = Range("A1" ).End(xlDown).Row
  13. fin1 = sht3.Range("A1" ).End(xlDown).Row
  14.   For ligne = 3 To fin
  15.      For ligne1 = 3 To fin1
  16.    ' Si cellule Feuil1 <> Feuil2
  17.    If Not (.Cells(ligne, 2) = sht3.Cells(ligne1, 2)) Then
  18.      ' cel Feuil2 prend la valeur Cel Feuil1
  19.     .Rows(ligne).Copy sht1.Rows(ligne2)
  20.     ligne2 = ligne2 + 1
  21.    End If
  22.   Next ligne1
  23.   Next ligne
  24. End With
  25.   Application.ScreenUpdating = True
  26. 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