Comparer valeur dans une colonne avec les colonnes precedentes

**Mimosa777** · 15/07/2015, 19h43

Salut a tous,

j'ai 5 colonnes avec comme titre des numeros tel que:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 12 | 7 | 12 | 8 | 7

J'ai une macro qui genere des donnees en function du numero de la colonne mais je souhaite seulement affiche les donnees pour le titre de la colonne une seule fois. Comme par exemple pour la colonne 12, je vais generer les donnees de la premiere colonne 12 et lorsque ma macro se rendra a la prochaine colonne 12, simplement ignorer cette colonne et passer a la suivante. Et ainsi de suite pour la colonne 7 dans ce cas.

J'espere que je vous confond pas avec mon explication. Merci de votre aide

**SfJ5Rpw8** · 16/07/2015, 11h00

Bonjour,

montre nous un peu de ton code qu'on voit comment il est organisé ... si tu fais une boucle sur tes colonnes tu peu-peu être utilisé une collection pour mémoriser les numéros de colonnes traitées ..

**Mimosa777** · 16/07/2015, 22h03

salut,

Jai reussi a le faire mais avec beaucoup de repetitions je crois - voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Sub Import_RoutesNames_Times()
 
    Dim sht As Worksheet
    Dim LastColumn As Long
    Dim LastRow As Long
    Dim RouteCol As Long
    Dim K As Integer  ' prochaine ligne vide dans la colonne B
    Set sht = Sheets("Paddle_Data")
    LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
    LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
    K = 13
    RouteCol = 3
 
    For i = 1 To 10 ' lastcolumn
        If Cells(12, RouteCol).Value <> sht.Cells(1, i).Value Then
        'do nothing
        Else
        'make sure that route is not already import in the B column
            If RouteCol <= 5 Then
                If Cells(12, RouteCol).Value <> Cells(12, RouteCol - 1).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 2).Value Then
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                        Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                        Else
                        Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = Cells(Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                ElseIf Cells(12, RouteCol + 1) <> "" Then
                    i = 1
                    RouteCol = RouteCol + 1
                End If
 
            ElseIf RouteCol > 5 And RouteCol <= 8 Then
                If Cells(12, RouteCol).Value <> Cells(12, RouteCol - 1).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 2).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 3).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 4).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 5).Value Then
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                        Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                        Else
                        Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = Cells(Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                ElseIf Cells(12, RouteCol + 1) <> "" Then
                    i = 1
                    RouteCol = RouteCol + 1
                End If
 
            ElseIf RouteCol > 8 And RouteCol <= 11 Then
                If Cells(12, RouteCol).Value <> Cells(12, RouteCol - 1).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 2).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 3).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 4).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 5).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 6).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 7).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 8).Value Then
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                        Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                        Else
                        Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = Cells(Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                ElseIf Cells(12, RouteCol + 1) <> "" Then
                    i = 1
                    RouteCol = RouteCol + 1
                End If
 
            ElseIf RouteCol > 11 And RouteCol <= 14 Then
                If Cells(12, RouteCol).Value <> Cells(12, RouteCol - 1).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 2).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 3).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 4).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 5).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 6).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 7).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 8).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 9).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 10).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 11).Value Then
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                        Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                        Else
                        Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = Cells(Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                ElseIf Cells(12, RouteCol + 1) <> "" Then
                    i = 1
                    RouteCol = RouteCol + 1
                End If
 
            ElseIf RouteCol > 14 And RouteCol <= 17 Then ' 17 jusqua la colonne Q
                If Cells(12, RouteCol).Value <> Cells(12, RouteCol - 1).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 2).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 3).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 4).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 5).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 6).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 7).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 8).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 9).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 10).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 11).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 12).Value _
                And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 13).Value And Cells(12, RouteCol).Value <> Cells(12, RouteCol - 14).Value Then
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                        Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                        Else
                        Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = Cells(Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                ElseIf Cells(12, RouteCol + 1) <> "" Then
                    i = 1
                    RouteCol = RouteCol + 1
                End If
 
 
            End If ' for routecol
 
        End If
 
    Next
 
 
End Sub

**Qwazerty** · 16/07/2015, 23h55

Salut

Essai pour voir si cette simplification fonctionne comme le code que tu nous as présenté, ça sera plus facile de travailler comme ça je pense.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Import_RoutesNames_Times()
 
    Dim sht As Worksheet
    Dim Tmpi As Long, Tmpy As Long, bTeste As Boolean
    Dim LastColumn As Long
    Dim LastRow As Long
    Dim RouteCol As Long
    Dim K As Integer  ' prochaine ligne vide dans la colonne B
    Set sht = Sheets("Paddle_Data")
    LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
    LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
    K = 13
    RouteCol = 3
 
 With Feuil2 'à personnaliser
    For i = 1 To 10 ' lastcolumn
        If .Cells(12, RouteCol).Value = sht.Cells(1, i).Value Then
            'pas de valeur inférieur à 3
            Tmpi = IIf(RouteCol < 3, 3, RouteCol)
            '=-2-(3*(ARRONDI.SUP((D6+1)/3;0)-2))
            Tmpi = -2 - (3 * (WorksheetFunction.RoundUp((Tmpi + 1) / 3, 0) - 2)) '-2,-5,-8,-11,-14
 
            'On boucle pour vérifier les conditions
            bTeste = False
            For Tmpy = -1 To Tmpi Step -1
                bTeste = .Cells(12, RouteCol).Value = .Cells(12, RouteCol + Tmpy).Value
                'Si une valeur identique on quite la boucle
                If bTeste Then Exit For
            Next
 
            If bTeste Then
                i = 1
                RouteCol = RouteCol + 1
                Exit For
            Else
                For j = 2 To 30 ' LastRow
                    If sht.Cells(j, i).Value <> "" Then
                        .Cells(K, 2).Value = sht.Cells(j, i).Value
                        K = K + 1
                    Else
                        Exit For
                    End If
                Next
                i = 1
                j = 2
                K = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                RouteCol = RouteCol + 1
            End If
        End If
    Next
End With
 
 
End Sub

Si le code précédent reproduit bien ton code initial, voila une modification pour résoudre ta demande (attention je n'ai pas testé le code)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub Import_RoutesNames_Times()
 
    Dim sht As Worksheet
    Dim Tmpi As Long, Tmpy As Long, bTeste As Boolean
    Dim StrEntete As String, TabEntete
    Dim LastColumn As Long
    Dim LastRow As Long
    Dim RouteCol As Long
    Dim K As Integer  ' prochaine ligne vide dans la colonne B
 
    'Initialisation
    Set sht = Sheets("Paddle_Data")
    LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
    LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
    K = 13
    RouteCol = 3
 
    With Feuil2 'à personnaliser
        For i = 1 To 10 ' lastcolumn
            'On vérifie que cette valeur n'a pas déjà été traitée
            TabEntete = Split(StrEntete, "¤")
            'On initialise bTeste, car si le tableau renvoyé est vide (1er colonne traitée) on doit traiter cette colonne par la suite
            bTeste = True
            For Tmpi = 0 To UBound(TabEntete)-1
                'Si bTeste passe à un la valeur de colonne a déjà été traitée
                bTeste = TabEntete(Tmpi) = .Cells(12, RouteCol).Value
                If bTeste Then Exit For
            Next
 
            If (.Cells(12, RouteCol).Value = sht.Cells(1, i).Value) And Not bTeste Then
                'Nouvelle valeur de colonne, on la mémorise
                StrEntete = "¤" & StrEntete
 
                'pas de valeur inférieur à 3
                Tmpi = IIf(RouteCol < 3, 3, RouteCol)
                '=-2-(3*(ARRONDI.SUP((D6+1)/3;0)-2))
                Tmpi = -2 - (3 * (WorksheetFunction.RoundUp((Tmpi + 1) / 3, 0) - 2)) '-2,-5,-8,-11,-14
 
                'On boucle pour vérifier les conditions
                For Tmpy = -1 To Tmpi Step -1
                    bTeste = .Cells(12, RouteCol).Value = .Cells(12, RouteCol + Tmpy).Value
                    'Si une valeur identique on quite la boucle
                    If bTeste Then Exit For
                Next
 
                If bTeste Then
                    i = 1
                    RouteCol = RouteCol + 1
                    Exit For
                Else
                    For j = 2 To 30 ' LastRow
                        If sht.Cells(j, i).Value <> "" Then
                            .Cells(K, 2).Value = sht.Cells(j, i).Value
                            K = K + 1
                        Else
                            Exit For
                        End If
                    Next
                    i = 1
                    j = 2
                    K = .Cells(.Rows.Count, "B").End(xlUp).Row + 1 ' add the +1 if you like to see redundancy of the main station
                    RouteCol = RouteCol + 1
                End If
            End If
        Next
    End With
 
 
End Sub

++
Qwaz

**Mimosa777** · 17/07/2015, 15h44

Merci Qwazerty,

je tente cette solution et te revient la dessus

Comparer valeur dans une colonne avec les colonnes precedentes

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager