XL 2016 Masquer / Afficher une colonne en modifiant la valeur dans une cellule

Steinner · 16 Juin 2021

Bonsoir,

Je cherche à faire une macro qui me permette de masquer/afficher certaines colonnes en fonction d'une valeur par exemple si ça vaut 1 la colonne est masqué et si elle vaut 2 elle ne l'ai pas, mais le code que j'ai réaliser ne fonctionne pas et je n'arrive pas à trouver la solution. Si quelqu'un à une idée je suis preneur

VB:

Sub Afficher_Masquer()
    Dim i As Integer
    For i = 38 To 39                    'Colonne à cacher
        If Cells(3, i + 26) = 2 Then    'Valeur déterminant si la colonne est cachée
            Cells(1, i).EntireColumn.Hidden = True
        Else
            Cells(1, i).EntireColumn.Hidden = False
        End If
    Next i
End Sub

Steinner · 18 Juin 2021

Alors, j'ai testé le code j'ai l'erreur 438 qui revient . Je te joins le fichier édulcoré.

Jacky67 · 18 Juin 2021

Steinner à dit:
Alors déjà merci beaucoup de m'aider et désolé pour le pavé. Normalement le fichier est épuré. Dans l'idée tout se passe dans l'onglet "hypothèses" qui me sert un peu de menu de réglage pour l'ensemble du fichier. En M21 et M22 j'ai mis 2 cases d'option (237 et 238) qui me permettent de faire la bascule entre 2 hypothèses et j'essaye de faire en sorte que dans l'onglet "Elément - MTO" En colonne AL,AM,AQ et AR si je click sur la première case d'option (237) que les colonnes disparaissent et qu'a l'inverse en cliquant sur la seconde (238) qu'elles réapparaissent.

Alors je n'utilise pas de userform mais j'ai des modules et c'est dans le 7 que j'ai mis les lignes de code d'ailleurs c'est la deuxième qui clignote en jaune

RE...
Avec des contrôles active X
Le code dans la feuille "Hypothèses"

VB:

Private Sub OptionButton1_Change()
 Sheets("Eléments - MTO").Range("AL:AM, AQ:AR").EntireColumn.Hidden = OptionButton1
End Sub

soan · 19 Juin 2021

Bonjour Steinner, Jacky,

regarde la feuille "Hypothèses" ; pour ce que tu avais fait avant pour les 2 boutons d'option, j'ai pas fait dans le détail : j'ai tout supprimé ! je te laisse voir et tester ce que j'ai mis à la place.

code VBA de Module1 :

VB:

Option Explicit

Sub Ratio()
  MsgBox "Ratio"
  'Sheets("Eléments - MTO").Range("AL:AM, AQ:AR").Columns.Hidden = ActiveSheet.OptionButton(237) = -1
End Sub

Sub Découpage()
  MsgBox "Découpage"
End Sub

Sub Masquer_ligne_Vide()
  Dim cel As Range: Application.ScreenUpdating = 0
  For Each cel In [C3:C50]
    If cel = "" Then cel.EntireRow.Hidden = True
  Next cel
End Sub

regarde aussi ton autre module ; question de Steinner : « oui, mais lequel ? » ; oh ben tu risques pas d'te tromper : y'en a plus qu'un seul autre ! c'est quand même plus simple que tes 7 modules 1 à 7, pas vrai ? je sais, 7 est un chiffre sympa, comme dans « les bottes de 7 lieues », ou « Blanche Neige et les 7 nains », mébon... évite quand même de briser un miroir, hein ? ça apporte 7 ans d'malheur ! alors au cas où tu s'rais superstitieux, je te laisse toucher du bois...

code VBA de Module2 (72 lignes) :

VB:

Option Explicit: Option Compare Text

'plusieurs subs de rechercheV (= VLookup en VBA)

Sub Numérique() 'pour les désignations numériques
  Dim resultats(1 To 1000, 1 To 3), dlA&, dlM&, j&
  With Sheets("Eléments - MTO")
    dlA = .Cells(.Rows.Count, 1).End(xlUp).Row: dlM = .Cells(.Rows.Count, 13).End(xlUp).Row
    For j = 5 To dlM
      resultats(j - 4, 1) = Application.VLookup(Range("M" & j), Sheets("Base de données").Range("A5:C" & dlA), 2, 0)
    Next j
    .Range("O5").Resize(UBound(resultats)) = WorksheetFunction.IfError(resultats, "")
  End With
End Sub

Sub Groupe() 'pour les groupes de matériaux
  Dim resultats(1 To 1000, 1 To 3), dlA&, dlM&, j&
  With Sheets("Eléments - MTO")
    dlA = .Cells(.Rows.Count, 1).End(xlUp).Row: dlM = .Cells(.Rows.Count, 13).End(xlUp).Row
    For j = 5 To dlM
      resultats(j - 4, 1) = Application.VLookup(Range("M" & j), Sheets("Base de données").Range("A5:C" & dlA), 3, 0)
    Next j
    .Range("Q5").Resize(UBound(resultats)) = WorksheetFunction.IfError(resultats, "")
  End With
End Sub

Sub DN_1() 'pour les DN (1)
  Dim resultats(1 To 1000, 1 To 3), dlA&, dlM&, j&
  With Sheets("Eléments - MTO")
    dlA = .Cells(.Rows.Count, 1).End(xlUp).Row: dlM = .Cells(.Rows.Count, 13).End(xlUp).Row
    For j = 5 To dlM
      resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:X" & dlA), 5, 0)
    Next j
    .Range("X5").Resize(UBound(resultats)) = WorksheetFunction.IfError(resultats, "")
  End With
End Sub

Sub DN_2() 'pour les DN (2)
Dim resultats(1 To 1000, 1 To 3), dlA&, dlM&, j&
  With Sheets("Eléments - MTO")
    dlA = .Cells(.Rows.Count, 1).End(xlUp).Row: dlM = .Cells(.Rows.Count, 13).End(xlUp).Row
    For j = 5 To dlM
      resultats(j - 4, 1) = Application.VLookup(Range("CB" & j), Sheets("Base de données").Range("T5:X" & dlA), 5, 0)
    Next j
    .Range("Y5").Resize(UBound(resultats)) = WorksheetFunction.IfError(resultats, "")
  End With
End Sub

Sub Masses() 'pour les masses
  Dim resultats(1 To 1000, 1 To 3), dlA&, dlM&, j&
  With Sheets("Eléments - MTO")
    dlA = .Cells(.Rows.Count, 1).End(xlUp).Row
    dlM = .Cells(.Rows.Count, 13).End(xlUp).Row
    For j = 5 To dlM
      ' Tube
      If (Range("R" & j) = "Tube") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:AD" & dlA), 11, 0)
      ' Coude
      If (Range("S" & j) = "2D/SR 45°") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:AP" & dlA), 23, 0)
      If (Range("S" & j) = "2D/SR 90°") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:AS" & dlA), 26, 0)
      If (Range("S" & j) = "3D/LR 45°") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:AV" & dlA), 29, 0)
      If (Range("S" & j) = "3D/LR 90°") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:AY" & dlA), 32, 0)
      ' Té égal
      If (Range("S" & j) = "Egal") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:BB" & dlA), 35, 0)
      ' Caps
      If (Range("R" & j) = "Caps") Then resultats(j - 4, 1) = Application.VLookup(Range("CA" & j), Sheets("Base de données").Range("T5:BE" & dlA), 38, 0)
      ' Bride
      If (Range("R" & j) = "Bride") Then resultats(j - 4, 1) = Application.VLookup(Range("CC" & j), Sheets("Base de données").Range("BJ5:BN" & dlA), 5, 0)
    Next j
    .Range("AF5").Resize(UBound(resultats)) = WorksheetFunction.IfError(resultats, "")
  End With
End Sub

maint'nant, si tu préfères quand même avoir 5 autres modules, c'est toi qui vois...

soan

Steinner · 19 Juin 2021

C'est bon ça marche !!!!!

Vraiment merci pour tout. Pour les 7 modules j'aime beaucoup ce chiffre mais c'était plus pour découpler les fonctions et parce que ça bug généralement quand je les réunis.

XL 2016 Masquer / Afficher une colonne en modifiant la valeur dans une cellule

Steinner

XLDnaute Nouveau

Steinner

XLDnaute Nouveau

Pièces jointes

Jacky67

XLDnaute Barbatruc

Pièces jointes

soan

XLDnaute Barbatruc

Pièces jointes

Steinner

XLDnaute Nouveau

Discussions similaires