IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Amélioration condition de calcul [XL-2010]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Mars 2015
    Messages
    110
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Chargé d'affaire
    Secteur : Bâtiment

    Informations forums :
    Inscription : Mars 2015
    Messages : 110
    Par défaut Amélioration condition de calcul
    le tableau recap est rempli via mon userformpri cela fonctionnement
    mais j'aimerais rajouter une condition
    si dans le tableau sur le même équipement exemple en 2016 note est B et quelle passe A en 2017 et que la case "changement equipement"checkbox1" est pas cocher lors de la validation un message dis "c'est pas possible car l’année dernière la note était inférieur"et cela revient sur l'userform
    merci de votre aide
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    'enregistrement et protection blocage des donnees'
     
    Private Sub CommandButton1_Click()
     
    Dim l_info As Integer
    Dim note_1 As String, note_2 As String, lanote As String
    Dim Ws As Worksheet
     
    'protection feuille
    Dim cell As Range
                    Dim pl As Range
                    Worksheets("TABLEAU RECAP").Visible = True
                    Worksheets("TABLEAU RECAP").Unprotect ("cedric")
                    Sheets("TABLEAU RECAP").Cells.Locked = True
                    For Each cell In Sheets("TABLEAU RECAP").Range("M2")
                        If cell.MergeCells = True Then
                            Set pl = cell.MergeArea
                            cell.UnMerge
                            cell.Locked = False
                            pl.Merge
                        Else
                            cell.Locked = False
                        End If
                    Next cell
                    Worksheets("TABLEAU RECAP").Protect ("cedric"), DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
     
     
    With ThisWorkbook.Worksheets("TABLEAU RECAP")
     l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
     
     
         .Range("B" & l_info).Value = ComEQUI 'libelle equipement'
            .Range("c" & l_info).Value = Textlocal 'code local"
            .Range("D" & l_info).Value = ComRESP 'Nom du responsable'
            .Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
            .Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
            .Range("G" & l_info).Value = CInt(TextDUREVIE.Value)  'Duree de vie theorique'
            .Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
            .Range("I" & l_info).Value = CInt(TextDURVIERESI.Value)  'Duree de vie residuelle '
            .Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
            .Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
            .Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'
     
    If CheckBox1.Value Then
    'cas case cochee
    .Range("p" & l_info).Value = "x"
    .Range("q" & l_info).Value = CDate(Textboxdatechange) 'date de remplacement équipement
    Else
    'cas case non cochee
    'rien ?
    End If
     
     
    With .Range("M" & l_info)
                    'formulation
                    .FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
                    'équivaut à un collage spécial valeur
                    .Value = .Value
                    note_1 = .Value
             End With
     
             With .Range("N" & l_info)
                    'formulation
                    .FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
                    'équivaut à un collage spécial valeur
                    .Value = .Value
                    note_2 = .Value
             End With
     
            Select Case True
                        Case note_1 = "Mauvais" And note_2 = "Faible"
                                lanote = "B"
                        Case note_1 = "Mauvais" And note_2 = "Moyenne"
                                lanote = "C"
                        Case note_1 = "Mauvais" And note_2 = "Forte"
                                lanote = "C"
     
                         Case note_1 = "Usuel" And note_2 = "Faible"
                                lanote = "A"
                        Case note_1 = "Usuel" And note_2 = "Moyenne"
                                lanote = "B"
                        Case note_1 = "Usuel" And note_2 = "Forte"
                                lanote = "B"
     
                         Case note_1 = "Bon" And note_2 = "Faible"
                                lanote = "A"
                        Case note_1 = "Bon" And note_2 = "Moyenne"
                                lanote = "A"
                        Case note_1 = "Bon" And note_2 = "Forte"
                                lanote = "A"
     
     
     
     
            End Select
     
            .Range("O" & l_info).Value = lanote
     
    Set Ws = ThisWorkbook.Worksheets("Donné équipement")
     l_info = Ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
           Ws.Range("G" & l_info).Value = lanote
     
     End With
     
    Me.hide
     
     
     
    Unload UserFormpri
     
    End Sub

  2. #2
    Membre chevronné
    Homme Profil pro
    Alternant
    Inscrit en
    Décembre 2015
    Messages
    413
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 30
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Alternant

    Informations forums :
    Inscription : Décembre 2015
    Messages : 413
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    If .Range("O" & l_info).Value <> lanote And CheckBox1.Value = False Then
    Msgbox("Note différente l'année dernière")
    Else
    ...
    End if
    A adapter

  3. #3
    Membre confirmé
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Mars 2015
    Messages
    110
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Chargé d'affaire
    Secteur : Bâtiment

    Informations forums :
    Inscription : Mars 2015
    Messages : 110
    Par défaut
    j ai fais des modification dans mon code mais il y a des condition qu'il ne fonctionne et je ne trouve pas du tout mes erreurs
    mon code modifier
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    Private Sub CommandButton1_Click()
    
    
    Dim l_info As Integer
    Dim l As Integer
    Dim note_1 As String, note_2 As String, lanote As String
    Dim ws As Worksheet
    Dim ds As Worksheet
    'protection feuille
    Dim cell As Range
                    Dim pl As Range
                    Worksheets("TABLEAU RECAP").Visible = True
                    Worksheets("TABLEAU RECAP").Unprotect ("cedric")
                    Sheets("TABLEAU RECAP").Cells.Locked = True
                    For Each cell In Sheets("TABLEAU RECAP").Range("M2")
                        If cell.MergeCells = True Then
                            Set pl = cell.MergeArea
                            cell.UnMerge
                            cell.Locked = False
                            pl.Merge
                        Else
                            cell.Locked = False
                        End If
                    Next cell
                    Worksheets("TABLEAU RECAP").Protect ("cedric"), DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
     
     
    With ThisWorkbook.Worksheets("TABLEAU RECAP")
     l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    
            
         .Range("B" & l_info).Value = ComEQUI 'libelle equipement'
            .Range("c" & l_info).Value = Textlocal 'code local"
            .Range("D" & l_info).Value = ComRESP 'Nom du responsable'
            .Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
            .Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
            .Range("G" & l_info).Value = CInt(TextDUREVIE.Value)  'Duree de vie theorique'
            .Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
            .Range("I" & l_info).Value = CInt(TextDURVIERESI.Value)  'Duree de vie residuelle '
            .Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
            .Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
            .Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'
            
     
     
            
    If CheckBox1.Value Then
    'cas case cochee
    .Range("p" & l_info).Value = "x"
    .Range("q" & l_info).Value = CDate(Textboxdatechange) 'date de remplacement équipement
    MsgBox ("attention imformer au equipe gmao le changement de l'equipement")
    Else
    'cas case non cochee
    'rien ?
    End If
    
     If UserFormpri.CheckBox1.Value = True Then
     UserForm2.TextBox6.Value = Me.ComEQUI.Value  'colle valeur équipement dans le texbox de l'uesrform2 et l'appeler
     UserForm2.Show
     Else
    'rien
    End If
    
            
    With .Range("M" & l_info)
                    'formulation
                    .FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
                    'équivaut à un collage spécial valeur
                    .Value = .Value
                    note_1 = .Value
             End With
     
             With .Range("N" & l_info)
                    'formulation
                    .FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
                    'équivaut à un collage spécial valeur
                    .Value = .Value
                    note_2 = .Value
             End With
     
            Select Case True
                        Case note_1 = "Mauvais" And note_2 = "Faible"
                                lanote = "B"
                        Case note_1 = "Mauvais" And note_2 = "Moyenne"
                                lanote = "C"
                        Case note_1 = "Mauvais" And note_2 = "Forte"
                                lanote = "C"
                                
                         Case note_1 = "Usuel" And note_2 = "Faible"
                                lanote = "A"
                        Case note_1 = "Usuel" And note_2 = "Moyenne"
                                lanote = "B"
                        Case note_1 = "Usuel" And note_2 = "Forte"
                                lanote = "B"
                                
                         Case note_1 = "Bon" And note_2 = "Faible"
                                lanote = "A"
                        Case note_1 = "Bon" And note_2 = "Moyenne"
                                lanote = "A"
                        Case note_1 = "Bon" And note_2 = "Forte"
                                lanote = "A"
                       
            End Select
        
    
    .Range("O" & l_info).Value = lanote 'donne de la note dans le tableau recap
    
    'si mon chexbox est cocher et que la note est superieur a l'annee d'avant message et fermeture de userform et sans validation dans le tableau recap
    
    Set ds = ThisWorkbook.Worksheets("Donnée équipement")
     l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
     ds.Range("G" & l).Value = lanote
     
    Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
    l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
    If ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
    If MsgBox("Note différente de l'année dernière", vbOK Or vbCancel) = vbOK Or vbCancel Then
    Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
      MsgBox ("Recommencer l'evaluation")
      
       End If
       
       Set ds = ThisWorkbook.Worksheets("Donnée équipement")
     l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
    If ds.Range("G" & l).Value = lanote = lanote And CheckBox1.Value = False Then
    ds.Range("G" & l).Value = lanote
    
    End If
    
    
    Set ds = ThisWorkbook.Worksheets("Donnée équipement")
     l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire
     If ds.Range("G" & l).Value < lanote And CheckBox1.Value = False Then
      End If
      
    Set ds = ThisWorkbook.Worksheets("Donnée équipement")
     l = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row  'si la note est superieur  a la donne dans G "donnée equipement" et chexbx coché
     If ds.Range("G" & l).Value < lanote And CheckBox1.Value = True Then
     ds.Range("G" & l).Value = lanote
     
         End If
         
    
    End If
    
     End With
    
    Call CreationBouton 'creation du bouton dans le tableau recap
    
    Me.hide
                                           
    Unload UserFormpri
    
    
    
    End Sub

  4. #4
    Membre confirmé
    Homme Profil pro
    Chargé d'affaire
    Inscrit en
    Mars 2015
    Messages
    110
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Chargé d'affaire
    Secteur : Bâtiment

    Informations forums :
    Inscription : Mars 2015
    Messages : 110
    Par défaut
    j ai encore modifier mon code pour les donne qui vont dans le tableau donne équipement mais cela ne marche toujours pas
    aide moi
    merci par avance
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
     
    Set ws = ThisWorkbook.Worksheets("TABLEAU RECAP")
    l_info = ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
    If ws.Range("O" & l_info).Value = "" Then 'donne de la note dans le tableau recap
    ws.Range("o" & l_info).Value = lanote
    ElseIf ws.Range("O" & l_info).Value > lanote And CheckBox1.Value = False Then
    If MsgBox("Note différente de l'année dernière", vbOK) = vbOK Then
    Sheets("TABLEAU RECAP").Range("b" & Sheets("TABLEAU RECAP").Range("b65000").End(xlUp).Row).EntireRow.ClearContents
      MsgBox ("Recommencer l'evaluation")
     
       End If
     
       Set ds = ThisWorkbook.Worksheets("Donnée équipement")
     L = ds.Cells.Find(ComEQUI.Value, , , xlWhole).Row
     
    If ds.Range("G" & L).Value = lanote = lanote And CheckBox1.Value = False Then
    ds.Range("G" & L).Value = lanote
     
    ElseIf ds.Range("G" & L).Value < lanote And CheckBox1.Value = False Then 'si la note est inferieur a la donne de G "donne equipement" et chexbox pas coché rien faire
     
    ElseIf ds.Range("G" & L).Value > lanote And CheckBox1.Value = True Then 'si la note est superieur  a la donne dans G "donnée equipement" et chexbox coché message et inscription de la nouvelle note
    ds.Range("G" & L).Value = lanote
     
    Else
    ds.Range("G" & L).Value = lanote
      End If
     
     
    End If
    passez tous de bonne fête

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Condition pour calcul
    Par majidbxl dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 22/03/2012, 16h51
  2. Amélioration temps de calcul => dll ?
    Par Suzuki3694 dans le forum MATLAB
    Réponses: 2
    Dernier message: 26/10/2011, 14h49
  3. conditions/formules calculs de dates
    Par hichem94120 dans le forum Excel
    Réponses: 5
    Dernier message: 08/11/2010, 01h09
  4. Condition de Calcul avec textbox
    Par jonathanoudelet dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 20/08/2008, 11h23
  5. [6.5.1] Condition avec calcul
    Par nawal59 dans le forum Débuter
    Réponses: 4
    Dernier message: 08/08/2008, 15h37

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo