Amélioration de programme

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Amélioration de programme

sadhya

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 :

Sub PMI()
'##############Définition des colonnes en format dates#####################
Dim i As Long
Dim stock As Date
fin = Range("A3" ).End(xlDown).Row
'##############Définition des colonnes en format dates#####################
Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
Columns("F" ).NumberFormat = "General"
'###############Transformation de la périodicité en jours##################
For i = 3 To fin
Cells(i, 6).Select
If Cells(i, 6).Value = "4 Ans" Then
Cells(i, 6).Value = "1460"
End If
If Cells(i, 6).Value = "3 Ans" Then
Cells(i, 6).Value = "1095"
End If
If Cells(i, 6).Value = "2 Ans" Then
Cells(i, 6).Value = "730"
End If
If Cells(i, 6).Value = "1 Ans" Then
Cells(i, 6).Value = "365"
End If
If Cells(i, 6).Value = "18 Mois" Then
Cells(i, 6).Value = "548"
End If
If Cells(i, 6).Value = "6 Mois" Then
Cells(i, 6).Value = "183"
End If
If Cells(i, 6).Value = "4 Mois" Then
Cells(i, 6).Value = "122"
End If
Next i
'############### Réécriture de la date prochaine ##################
For i = 3 To fin
Cells(i, 5).Select
Cells(i, 4).Select
Cells(i, 6).Select
If Cells(i, 5).Value = "-" Then
Cells(i, 5).Value = Application.Sum(Cells(i, 4).Value, Cells(i, 6).Value)
End If
Next i
'############### Définition de l'intervalle de travail ##################
Const PR = vbLf & vbLf & "Entrer la date de ", TI = " INTERVALLE"
Dim DateDebut As Date, DateFin As Date, Dstock As Date
D = InputBox(PR & "début :", TI, "01/01/" & Year(Now))
If IsDate(D) Then DateDebut = D Else Exit Sub
D = InputBox(PR & "fin :", TI, D): If IsDate(D) Then DateFin = D
If DateFin < DateDebut Then Beep: Exit Sub
Application.ScreenUpdating = False
For R = Cells(Rows.Count, 5).End(xlUp).Row To 2 Step -1
If IsDate(Cells(R, 5)) Then
Dstock = Cells(R, 5)
If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
End If
Next
Application.ScreenUpdating = True
End sub

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

Publicité

Marc L

(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

sadhya

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

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

Marc L

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

sadhya

Salut Marc L ,

Génial ça fonctionne voici le code :

Code :

Sub PMI()
'##############Définition des colonnes en format dates#####################
Dim i As Long
Dim stock As Date
fin = Range("A3" ).End(xlDown).Row
Const PR = vbLf & vbLf & "Entrer la date de ", TI = " INTERVALLE"
Dim DateDebut As Date, DateFin As Date, Dstock As Date
D = InputBox(PR & "début :", TI, "01/01/" & Year(Now))
Application.ScreenUpdating = False
'##############Définition des colonnes en format dates#####################
Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
Columns("F" ).NumberFormat = "General"
'###############Transformation de la périodicité en jours##################
For i = 3 To fin
Select Case Cells(i, 6).Value
Case "4 Ans"
Cells(i, 6).Value = 1460
Case "3 Ans"
Cells(i, 6).Value = 1095
Case "2 Ans"
Cells(i, 6).Value = 730
Case "1 Ans"
Cells(i, 6).Value = 365
Case "18 Mois"
Cells(i, 6).Value = 549
Case "6 Mois"
Cells(i, 6).Value = 183
Case "4 Mois"
Cells(i, 6).Value = 122
End Select
Next i
'############### Réécriture de la date prochaine ##################
For i = 3 To fin
If Cells(i, 5).Value = "-" Then
Cells(i, 5).Value = Cells(i, 4).Value + Cells(i, 6).Value
End If
Next i
'############### Définition de l'intervalle de travail ##################
If IsDate(D) Then DateDebut = D Else Exit Sub
D = InputBox(PR & "fin :", TI, D): If IsDate(D) Then DateFin = D
If DateFin < DateDebut Then Beep: Exit Sub
For R = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1
If IsDate(Cells(R, 5)) Then
Dstock = Cells(R, 5)
If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
End If
Next
Application.ScreenUpdating = True
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 :

Sub Retardpmi()
Dim wkb As Workbook: Set wkb = ThisWorkbook
ligne2 = 3
With wkb
Dim sht1 As Worksheet: Set sht1 = Worksheets("Feuil1" )
Dim sht2 As Worksheet: Set sht2 = Worksheets("Feuil2" )
Dim sht3 As Worksheet: Set sht3 = Worksheets("Feuil3" )
End With
Application.ScreenUpdating = False
With sht2 ' Feuille 2
fin = Range("A1" ).End(xlDown).Row
fin1 = sht3.Range("A1" ).End(xlDown).Row
For ligne = 3 To fin
For ligne1 = 3 To fin1
' Si cellule Feuil1 <> Feuil2
If Not (.Cells(ligne, 2) = sht3.Cells(ligne1, 2)) Then
' cel Feuil2 prend la valeur Cel Feuil1
.Rows(ligne).Copy sht1.Rows(ligne2)
ligne2 = ligne2 + 1
End If
Next ligne1
Next ligne
End With
Application.ScreenUpdating = True
End Sub

As tu des propositions à me faire ?

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

Marc L

Pas mal !

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

Code :

Sub PMI()
Const PR = vbLf & vbLf & "Entrer la date de ", TI = " INTERVALLE"
Dim DateDebut As Date, DateFin As Date, Dstock As Date
' Définition de l'intervalle de travail
D = InputBox(PR & "début :", TI, "01/01/" & Year(Now))
If IsDate(D) Then DateDebut = D Else Exit Sub
D = InputBox(PR & "fin :", TI, D): If IsDate(D) Then DateFin = D
If DateFin < DateDebut Then Beep: Exit Sub
Application.ScreenUpdating = False
' Définition des formats de colonnes
' Columns("D:E" ).NumberFormat = "dd/MM/yyyy"
' Columns("F" ).NumberFormat = "General"
For R = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1
' Transformation de la périodicité en jours
If InStr(Cells(R, 6), "Ans" ) Then Cells(R, 6) = Val(Cells(R, 6)) * 365 Else _
If InStr(Cells(R, 6), "Mois" ) Then Cells(R, 6) = Val(Cells(R, 6)) * 30.5
' Réécriture de la date prochaine
If Cells(R, 5) = "-" And IsDate(Cells(R, 4)) And IsNumeric(Cells(R, 6)) Then _
Cells(R, 5) = CDate(Cells(R, 4)) + Cells(R, 6)
' Suppression des lignes hors intervalle
If IsDate(Cells(R, 5)) Then Dstock = Cells(R, 5) Else Dstock = 0
If Dstock < DateDebut Or Dstock > DateFin Then Rows(R).Delete
Next
Application.ScreenUpdating = True
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

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Amélioration de programme

Sujets relatifs
Aide programme démineur	aide programme fortran
Programme fonctionnant avec proxy et pas sans	[C] A l'aide je ne comprends rien a ce programme
Programme VBA trouvant une valeur répondant à des conditions ET/OU	SOS VBA Besoin d'aide pour un programme
Printf qui change le résultat d'un programme ??	Programme débutant
Re-programmer un logiciel ?	Pb pour fermer programme avec touche clavier. (VB)
Plus de sujets relatifs à : Amélioration de programme

Page générée en 0.088 secondes