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

B

biker

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
B

biker

XLDnaute Occasionnel
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
Cliquez pour agrandir...


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
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
570
Phil69970
Phil69970
F
  • Question
XL 2019 l'indice n'appartient pas à la sélection
Réponses
9
Affichages
583
job75
job75
D
  • Question
XL 2016 VBA format date
2
Réponses
17
Affichages
919
vgendron
vgendron
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
272
florian50470
F
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
L
  • Question
XL 2016 Erreur 28 : Espace de pile insuffisant
Réponses
6
Affichages
454
patricktoulon
patricktoulon
M
  • Résolu(e)
Microsoft 365 Décalage de ligne lors de la saisie
2 3
Réponses
37
Affichages
1 K
Marvin57
M
A
  • Résolu(e)
XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox
Réponses
3
Affichages
344
Aldonanou
A
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA ADODB RECSET : écrire le résultats dans deux cellules.
Réponses
2
Affichages
284
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
256
guiyom
G

Membres actuellement en ligne

14 membres et 86 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 502
Messages
2 089 034
Membres
104 010
dernier inscrit
Freba