est-ce que ces deux codes peuvent ils etre simplifié ?

biker · 17 Août 2012

Bonjour; (DÉBUTANT)

J'aimerai savoir si ces deux codes peuvent ils etre simplifié

Code:

Sub Cal()

Dim i As Integer

'Test de cellule non vide sur la colonne D (affecte sur variable mais aussi dans une cellule)
    NbCellVide = WorksheetFunction.CountBlank(Range(Cells(7, 4), Cells(2000, 4)))
        Range("C6") = 1994 - NbCellVide
            Nbligne = Range("C6")
'effacement des données pour calcul Colonne I,J,L,M,N,O
    Range("I7:J" & Nbligne+6).ClearContents
    Range("L7:O" & Nbligne+6).ClearContents
'Variable i va successivement prendre la valeur jusqu' a Derncellule vide + 6
    For i = 7 To Nbligne + 6
'Ecrit dans la plage de cellules I (Affectation de la périodicité pour le calcul) et
'Ecrit dans la plage de cellules J (Affectation de la base d'arlerte pour le calcul)
        If Cells(i, 8) = "D" And Cells(i, 7) = "Quotidien" Then
            Cells(i, 9) = "1"
            Cells(i, 10) = "1"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Bihebdomadaire" Then
            Cells(i, 9) = "3"
            Cells(i, 10) = "0.99"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Hebdomadaire" Then
            Cells(i, 9) = "7"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Mensuel" Then
            Cells(i, 9) = "30"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Bimestriel" Then
            Cells(i, 9) = "61"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Trimestriel" Then
            Cells(i, 9) = "91"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Semestriel" Then
            Cells(i, 9) = "183"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Annuel" Then
            Cells(i, 9) = "365"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Bisannuel" Then
            Cells(i, 9) = "730"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Triennal" Then
            Cells(i, 9) = "1096"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Quadiennal" Then
            Cells(i, 9) = "1461"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "D" And Cells(i, 7) = "Quinquennal" Then
            Cells(i, 9) = "1826"
            Cells(i, 10) = "0.85"
        End If
        If Cells(i, 8) = "C" Then
            Cells(i, 9) = Cells(i, 7)
            Cells(i, 10) = "0.95"
        End If
       Next i
End Sub

Code:

Private Sub ComboBox2_Change()
'
'Affectation du Label en fonction du Combo
    If ComboBox2 = "Quotidien" Then Label7 = "qui a lieu une fois par jours"
    If ComboBox2 = "Bihebdomadaire" Then Label7 = "qui a lieu deux fois par semaine"
    If ComboBox2 = "Hebdomadaire" Then Label7 = "qui a lieu une fois par semaine"
    If ComboBox2 = "Mensuel" Then Label7 = "qui a lieu une fois par mois"
    If ComboBox2 = "Bimestriel" Then Label7 = "qui a lieu tous les deux mois"
    If ComboBox2 = "Trimestriel" Then Label7 = "qui a lieu tous les trois mois"
    If ComboBox2 = "Semestriel" Then Label7 = "qui a lieu tous les six mois"
    If ComboBox2 = "Annuel" Then Label7 = "qui a lieu une fois par an"
    If ComboBox2 = "Bisannuel" Then Label7 = "qui a lieu tous les deux ans"
    If ComboBox2 = "Triennal" Then Label7 = "qui a lieu tous les trois ans"
    If ComboBox2 = "Quadiennal" Then Label7 = "qui a lieu tous les quatre ans"
    If ComboBox2 = "Quinquennal" Then Label7 = "qui a lieu tous les cinq ans"
    If ComboBox2 = "" Then Label7 = ""
End Sub

Je vous en remercie par avance de vos reponses.

Cordialement

ChTi160 · 17 Août 2012

Re : est-ce que ces deux codes peuvent ils etre simplifié ?

Bonjour biker
Bonjour le fil
Bonjour Le Forum
ci dessous le code que j'ai testé (sur quelques lignes seulement , car il est bien de joindre un fichier )

VB:

Sub test()
Dim ArrVar, Arrperiodicite
Dim I As Integer
Dim Item As Byte
Application.ScreenUpdating = False
          ArrVar = Array("Quotidien", "Bihebdomadaire", "Hebdomadaire", "Mensuel", "Bimestriel", "Trimestriel", _
                         "Semestriel", "Annuel", "Bisannuel", "Triennal", "Quadiennal", "Quinquennal")
  Arrperiodicite = Array("1", "3", "7", "30", "61", "91", "183", "365", "730", "1096", "1461", "1826")
 With Worksheets("feuil1") 'avec la feuille "Feuil1"
  For i = 1 To 14 'pour les ligne 1 à 4 à adapter
       For Item = 0 To UBound(ArrVar) 'pour chaque élément de du tableau
       If .Cells(i, 8) = "D" And .Cells(i, 7) = ArrVar(Item) Then 'si condition remplie
               .Cells(i, 9) = Arrperiodicite(Item) 'on l'equivalent du tableau Arrperiodicite
               .Cells(i, 10) = IIf(ArrVar(Item) = "Quotidien", "1", IIf(ArrVar(Item) = "Bihebdomadaire", "0.99", "0.85")) 'on compléte via la double condition
                  Exit for 'ici on quitte la boucle si trouvé
        ElseIf .Cells(i, 8) = "C" Then
               .Cells(i, 9) = .Cells(i, 7)
               .Cells(i, 10) = "0.95"
           Exit for'ici on quitte la boucle si trouvé
       End If

       Next Item
  Next i
End With
Application.ScreenUpdating = True
End Sub

ne pas hésiter à tester
Bonne journée
Amicalement
Jean Marie

biker · 17 Août 2012

Re : est-ce que ces deux codes peuvent ils etre simplifié ?

ChTi160 à dit:

Bonjour biker
Bonjour le fil
Bonjour Le Forum
ci dessous le code que j'ai testé (sur quelques lignes seulement , car il est bien de joindre un fichier )

Code:

Sub test()
Dim ArrVar, Arrperiodicite
Application.ScreenUpdating = False
          ArrVar = Array("Quotidien", "Bihebdomadaire", "Hebdomadaire", "Mensuel", "Bimestriel", "Trimestriel", _
                         "Semestriel", "Annuel", "Bisannuel", "Triennal", "Quadiennal", "Quinquennal")
  Arrperiodicite = Array("1", "3", "7", "30", "61", "91", "183", "365", "730", "1096", "1461", "1826")
 With Worksheets("feuil1") 'avec la feuille "Feuil1"
  For i = 1 To 14 'pour les ligne 1 à 4 à adapter
       For Item = 0 To UBound(ArrVar) 'pour chaque élément de du tableau
       If .Cells(i, 8) = "D" And .Cells(i, 7) = ArrVar(Item) Then 'si condition remplie
            .Cells(i, 9) = Arrperiodicite(Item) 'on l'equivalent du tableau Arrperiodicite
            .Cells(i, 10) = IIf(ArrVar(Item) = "Quotidien", "1", IIf(ArrVar(Item) = "Bihebdomadaire", "0.99", "0.85")) 'on compléte via la double condition
       
        ElseIf .Cells(i, 8) = "C" Then
            .Cells(i, 9) = .Cells(i, 7)
            .Cells(i, 10) = "0.95"
       End If

       Next Item
  Next i
End With
Application.ScreenUpdating = True
End Sub

ne pas hésiter à tester
Bonne journée
Amicalement
Jean Marie

Je vais le testé et je vous tiendrai au courant.
En temps normal je mets mon fichier en piece jointe mais la celui-ci contient 16 USF et 6 Modules. Donc pour expliquer la cible de mon petit probleme ; j'aurai du ecrire un roman.
Merci de votre comprehension.

Et pour le combobox ; j'ai essayer avec le select case ; cela marche parfaitement mais cela augmente la taille de mon fichier.

Merci Jean Marie

ChTi160 · 17 Août 2012

Re : est-ce que ces deux codes peuvent ils etre simplifié ?

Re
pour ce qui est du combobox2 tu devrais pouvoir via la procédure sur les cellules et ArrVar organiser un boucle du même genre
je suis en plein travaux chez moi lol et je vais attaquer
je regarde des que possible
Bonne journée
Amicalement
Jean Marie

ChTi160 · 17 Août 2012

Re : est-ce que ces deux codes peuvent ils etre simplifié ?

Re
arff vite fait la colle va prendre lol
une procédure dans ce genre non testée

VB:

Private Sub ComboBox2_Change()
Dim ArrVar, Arrperiodicite
Dim Item As Byte
Const ConstStr As String = "qui a lieu"

          ArrVar = Array("Quotidien", "Bihebdomadaire", "Hebdomadaire", "Mensuel", "Bimestriel", "Trimestriel", _
                         "Semestriel", "Annuel", "Bisannuel", "Triennal", "Quadiennal", "Quinquennal")
  Arrperiodicite = Array("une fois par jours", "deux fois par semaine", "une fois par semaine", "une fois par mois", "tous les deux mois", "tous les trois mois", _
         "tous les six mois", "une fois par an", "tous les deux ans", "tous les trois ans", "tous les quatre ans", "tous les cinq ans")
 With Userform1 'avec la forme
 
    For Item = 0 To UBound(ArrVar) 'pour chaque élément de du tableau
       If .ComboBox2 = ArrVar(Item) Then  'si combobox =
               .Label7 = ConstStr & " " & Arrperiodicite(Item) 'alors label= "qui a lieu" et la variable
            Exit For 'ici on quitte la boucle si trouvé
          ElseIf ComboBox2 = "" Then
               .Label7 = ""
            Exit For 'ici on quitte la boucle si trouvé
       End If

    Next Item
  
End With

End Sub

bon test
Bonne journée
Amicalement
Jean Marie

biker · 17 Août 2012

Re : est-ce que ces deux codes peuvent ils etre simplifié ?

Merci Jean Marie; j'espere que la colle n'a pas prise ; cela fonctionne.

Merci

Effectuez une recherche sur Excel Downloads...

est-ce que ces deux codes peuvent ils etre simplifié ?

biker

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

biker

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

biker

XLDnaute Occasionnel

Discussions similaires

Nous accordons de l'importance à votre vie privée