Macro masque et groupe?

VBA
6

Bonjour
Voilà deux macros

Macro pour Masquer

Sub doublons()
Dim Dl%, F$
  Application.Calculation = xlCalculationManual
  Cells.EntireColumn.Hidden = False 'Affiche les colonnes
  Cells.EntireRow.Hidden = False 'Affiche les lignes
  Columns("A:A").Select
  Selection.EntireColumn.Hidden = True 'Masque colonne A
  Columns("D:K").Select
  Selection.EntireColumn.Hidden = True 'Masque colonne D à K
  Columns("M:Q").Select
  Selection.EntireColumn.Hidden = True 'Masque les colonnes M à Q
  
  Dl = Range("B" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne B
  
  F = "=IF(AND(IF(RC[-6]="""","""",IF(COUNTIF(R1C2:R[-1]C[-16],RC[-16])>0,"""",MAX(R1C18:R[-1]C)+1))="""",RC[-16]=R[-1]C[-16]),R[-1]C,IF(RC[-6]="""","""",IF(COUNTIF(R1C2:R[-1]C[-16],RC[-16])>0,"""",MAX(R1C18:R[-1]C)+1)))"
  Range("R2").Formula = F 'Attribue la formule à R2
  Range("R2").AutoFill Destination:=Range("R2:R" & Dl), Type:=xlFillDefault 'Recopie la formule
  Application.Calculation = xlCalculationAutomatic
  Range("R2:R" & Dl).Copy 'Copy la plage pour la copier en valeur
  Range("R2").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Application.CutCopyMode = False
  
  Range("R2:R" & Dl).SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = True 'Masque les lignes contenant du numérique
  Range("B1").Select
End Sub

Macro pour Afficher

Sub Affiche()
  Cells.EntireColumn.Hidden = False 'Affiche les colonnes
  Cells.EntireRow.Hidden = False 'Affiche les lignes
  Range("A1").Select
End Sub

A toi de mettre les boutons adéquat où bon te semble
FiltreBCL.xls (842 Ko)

1 « J'aime »