Masquer plusieurs colonnes sur plusieurs critères vba

Résolu

Looping38 Messages postés 91 Date d'inscription Statut Membre Dernière intervention -
Looping38 Messages postés 91 Date d'inscription Statut Membre Dernière intervention - 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

A voir également:

Masquer plusieurs colonnes sur plusieurs critères vba
Formule moyenne excel plusieurs colonnes - Guide
Classer par ordre alphabétique excel plusieurs colonnes - Guide
Comment faire des colonnes sur word - Guide
Comment masquer les amis sur facebook - Guide
Masquer conversation whatsapp - Guide

1 réponse

Réponse 1 / 1

Looping38 Messages postés 91 Date d'inscription Statut Membre Dernière intervention 1

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

Discussions similaires

Addition avec plusieurs critères au sein d'une même colonne

Story bloque

Votre réponse

Discussions similaires