Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

S

Steinner

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

Jacky67

XLDnaute Barbatruc
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
 

Pièces jointes

  • Projet V1.zip
    560.3 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
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
 

Pièces jointes

  • Projet C.zip
    550.6 KB · Affichages: 3
Vote positif 0 Vote négatif
S

Steinner

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Question
XL 2013 Bouton commande ne fonctionne pas
Réponses
7
Affichages
219
midovic
M
D
  • Résolu(e)
XL 2016 VAB : Masquer les lignes si la cellule en J contient "clôturée"
Réponses
3
Affichages
291
daviddemetz72
D
B
  • Question
Microsoft 365 [RESOLU] Supprimer Ligne rapidement et avec plusieurs conditions
Réponses
5
Affichages
115
BENAM69
B
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
325
escudo
E
  • Résolu(e)
XL 2021 (Résolu) Aide vrai/faux dans plusieurs colonnes de cases à cocher
2
Réponses
27
Affichages
382
Dranreb
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
142
GClaire
G
C
  • Résolu(e)
XL 2021 Aide pour affichage colonne listbox après une recherche par textbox
Réponses
10
Affichages
260
Claudinedu13
C
B
  • Question
XL 2016 Macro pour identifier un texte dans un tableau et appliquer une modification sur une cellule sur la même ligne
Réponses
5
Affichages
254
ChTi160
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
192
ZiM
Z
J
  • Question
XL 2019 Renvoyer une valeur dans une cellule (explication ci-dessous)
Réponses
5
Affichages
146
Jean-Luc P.
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…