[VBA] Supprimer colonnes identiques

actaris51

XLDnaute Occasionnel
Bonjour,

J'ai besoin d'aide pour faire une macro.
J'ai un fichier excel de ce type :

Cijoint.fr - Service gratuit de dépôt de fichiers

En gros une base de temps (la premiere ligne), et un certains nombre de variables qui prennent des valeurs au cours du temps. Par exemple dans ce fichier mes lignes 3 à 23 correspondent a 20 variables qui prennent des valeurs pendant le laps de temps entre 0,0 et 0,2.

J'aimerai faire une macro qui masque (ou qui supprime) automatiquement les colonnes ou l'ensemble des variables ne change pas de valeur. En gros si les colonnes cote a cote sont identiques, mis à part le temps qui évolue.

Par exemple dans le fichier joint, il ne faudrait garder que les colonnes A,C,F,G,I et J.

Pouvez vous m'aider ?

Merci !

<config>Windows XP / Internet Explorer 6.0</config>
 

tototiti2008

XLDnaute Barbatruc
Re : [VBA] Supprimer colonnes identiques

Bonjour actaris,

à tester

Code:
Sub test()
Dim i As Long, j As Long, Valeurs, ValeursPrec, EstEgal As Boolean
    For i = Range("IV1").End(xlToLeft).Column To 2 Step -1
        Valeurs = Range(Cells(3, i), Cells(23, i)).Value
        ValeursPrec = Range(Cells(3, i - 1), Cells(23, i - 1)).Value
        EstEgal = True
        For j = LBound(Valeurs) To UBound(Valeurs)
            If Valeurs(j, 1) <> ValeursPrec(j, 1) Then
                EstEgal = False
                Exit For
            End If
        Next j
        If EstEgal Then
            Cells(1, i).EntireColumn.Delete
        End If
    Next i
End Sub
 

Minick

XLDnaute Impliqué
Re : [VBA] Supprimer colonnes identiques

Salut,

Une autre version:
Code:
Option Explicit

Sub Masque()
    Dim CptCol As Integer
    Dim Serie1 As String, Serie2 As String
    
    Serie1 = Join(Application.Transpose(Range("A3:a23")))
    For CptCol = 2 To 23
        Serie2 = Join(Application.Transpose(Range(Cells(3, CptCol), Cells(23, CptCol))))
        If Serie1 = Serie2 Then
            Columns(CptCol).Hidden = True
        Else
            Serie1 = Serie2
        End If
    Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 734
Messages
2 082 020
Membres
101 872
dernier inscrit
Colin T