Menu

Masquer plusieurs colonnes sur plusieurs critères vba [Résolu]

Messages postés
89
Date d'inscription
samedi 22 octobre 2016
Dernière intervention
10 décembre 2018
- - Dernière réponse : Looping38
Messages postés
89
Date d'inscription
samedi 22 octobre 2016
Dernière intervention
10 décembre 2018
- 6 déc. 2018 à 16:01
Bonjour,
J'ai créée un classeur de comparaison de mutuelles.
Les mutuelles sont en colonnes , les garanties en lignes.
Je souhaite insérer une croix ligne 96 de la colonne si la garanties est inférieur à celle indiquée sur le userform (sauf dernier critère est supérieur).

Aperçu du UserForm



Si déjà croix ligne 96 , ne rien faire sur la colonne (masquée ou pas)
Si valeur de textbox testée est supérieur, pas de croix ligne 96
Si valeur de textbox testée inférieur : mettre une croix ligne 96 de la colonne
Si la valeur de la ligne de la colonne est "Frais réels" pas de croix ligne 96

Quand je met uniquement un seul critère, cela fonctionne, mais dès que je mets un deuxième, alors si ce critère dit "pas de croix", il enlève la croix...
Je souhaiterai que si le premier passage applique une croix, alors, cette colonne ne soit plus dans la boucle.
J'avais pensé mettre la croix, puis masquer la colonne, mais je n'arrive pas à traiter les colonnes visibles uniquement.
Le principe de mettre une croix est nécessaire à d'autres macros.
J'utilise actuellement le code suivant :
Dans l'idéal, le code suivant serait à mettre en fin de macro uniquement pour ne pas ralentir le traitement (85 colonnes...) :
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next


Dim dercol As Integer
Dim nbrecol As Integer

Private Sub appliquer_filtres()
Application.ScreenUpdating = False
Application.EnableEvents = False


DernCol = ActiveSheet.Cells(14, Cells.Columns.Count).End(xlToLeft).Column
For n = 7 To DernCol
Columns(n).Hidden = False
Next n

'Call Appliquer_préférences


nbrecol = DernCol - 6



For n = 7 To derncol

'*********** Honnoraires Hospi ***************
If Val(Cells(14, n).Value) < Val(Me.TextBox19.Value) And Cells(14, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
' ********** Chambre particulière ************

If Val(Cells(21, n)) < Val((Me.TextBox20.Value)) And Cells(21, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next

'*********** Allocation Naissance *************

If Val(Cells(29, n)) < Val((Me.TextBox21.Value)) And Cells(29, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
'*********** Honoraires spécialistes ***********

If Val(Cells(33, n)) < Val((Me.TextBox22.Value)) And Cells(33, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
'*********** Médecines douces *****************

If Val(Cells(46, n)) < Val((Me.TextBox23.Value)) And Cells(46, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
'*********** Appareillage *********************

If Val(Cells(57, n)) < Val((Me.TextBox24.Value)) And Cells(57, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
'*********** Prothèses dentaires ***************

If Val(Cells(84, n)) < Val((Me.TextBox25.Value)) And Cells(84, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next
'*********** Orthodontie ***********************

If Val(Cells(80, n)) < Val((Me.TextBox26.Value)) And Cells(80, n).Value <> "Frais Réels" Then
Cells(96, n).Value = "x"
Else: Cells(96, n).Value = ""
End If
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next

'*********** Tarif Maxi ***********************

If Val(Cells(89, n)) > Val((Me.TextBox27.Value)) Then Cells(96, n).Value = "x"
For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next

Next n



Call Appliquer_préférences
Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveCell.Select
Me.Hide
End Sub



Configuration: Windows / Chrome 70.0.3538.110
Afficher la suite 

Votre réponse

1 réponse

Messages postés
89
Date d'inscription
samedi 22 octobre 2016
Dernière intervention
10 décembre 2018
0
Merci
Sans retour du forum, j'ai bricolé ça qui fonctionne finalement.
Le else m'enlevait la croix sur les conditions suivantes...
J'ai également enlevé l'appel de la macro Appliquer_Préférences qui ré-affichait toutes les colonnes.
Si ça peut servir...

Application.ScreenUpdating = False
Application.EnableEvents = False


derncol = ActiveSheet.Cells(14, Cells.Columns.Count).End(xlToLeft).Column
For n = 7 To derncol
Columns(n).Hidden = False
Next n




nbrecol = derncol - 6



For n = 7 To derncol

'*********** Honnoraires Hospi ***************
If Val(Cells(14, n).Value) < Val(Me.TextBox19.Value) And Cells(14, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
' ********** Chambre particulière ************
If Val(Cells(21, n)) < Val((Me.TextBox20.Value)) And Cells(21, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Allocation Naissance *************
If Val(Cells(29, n)) < Val((Me.TextBox21.Value)) And Cells(29, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Honoraires spécialistes ***********
If Val(Cells(33, n)) < Val((Me.TextBox22.Value)) And Cells(33, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Médecines douces *****************
If Val(Cells(46, n)) < Val((Me.TextBox23.Value)) And Cells(46, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Appareillage *********************
If Val(Cells(57, n)) < Val((Me.TextBox24.Value)) And Cells(57, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Prothèses dentaires ***************
If Val(Cells(84, n)) < Val((Me.TextBox25.Value)) And Cells(84, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Orthodontie ***********************
If Val(Cells(80, n)) < Val((Me.TextBox26.Value)) And Cells(80, n).Value <> "Frais Réels" Then Cells(96, n).Value = "x"
'*********** Tarif Maxi ***********************
If Val(Cells(89, n)) > Val((Me.TextBox27.Value)) Then Cells(96, n).Value = "x"
Next

For x = 7 To derncol
If Cells(96, x) = "x" Then Columns(x).Hidden = IIf(Columns(x).Hidden = True, False, True)
Next

''************Application des préférences
For n = 7 To derncol

If Cells(10, n) = UserForm6.TextBox1.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox2.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox3.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox4.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox5.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox6.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox7.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox8.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox9.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox10.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox11.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox12.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox13.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

If Cells(10, n) = UserForm6.TextBox14.Value Then Columns(n).Hidden = True 'Else Columns(n).Hidden = False

Next n



Application.EnableEvents = True
Application.ScreenUpdating = True
ActiveCell.Select
Me.Hide
End Sub
Commenter la réponse de Looping38