Export vers autre onglet - Bug sur boucle origine inconnue

**bickou** · 23/04/2015, 17h58

Bonjour à tous,

Je bloque depuis des heures sur un bug dont je ne trouve pas l'origine.

Etape 1 : J'ai un code qui à partir d'un onglet Excel "Saisie" réparti les données selon une colonne "bâtiment" dans un onglet pour chaque bâtiment.
Etape 2 : Pour chaque onglet après avoir classé les données selon certaines colonnes, je concatène des lignes si les valeurs au sein de ces colonnes sont identiques.

L'étape 1 fonctionne très bien.
L'étape 2 fonctionne si je n'ai qu'un seul "bâtiment". Par contre si j'en ai plusieurs ça plante lors de la concaténation, le classement des données fonctionne si j'enlève la partie de code qui concatène.

L'erreur semble être due à la valeur de K que je modifie si j'ai des lignes identiques.
L'objectif étant de supprimer la ligne 2 si elle est identique à la ligne 1. Je souhaite à K+1 comparer la ligne 1 à la ligne 3 si la ligne 2 disparaît

Petit exemple :
K = 1 -> Ligne K (ligne 1) = Ligne K+1 (ligne 2) -> suppression ligne K+1 (ligne 2) après avoir mis les données sur ligne K
K = 2 -> Ligne K (ligne 2 : ex ligne 3) = Ligne K+1 (ligne 3 : ex ligne 4) ...

Si je ne fais pas K = K-1 avant d'entamer la boucle suivante je ne compare pas la ligne 1 et 3 après suppression de la ligne 2

Voici 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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer 'Variables de boucles
Dim X As Integer, Y As Integer, W As Integer 'Variables comparatives
Dim Tableau1() As String, Tableau2() As String 'Variables tableaux
Dim Z As String 'Variable simplificatrice
 
‘Fusion des lignes similaires 
For I = 7 To Sheets.Count 'Boucle sur feuille
      Z = " / "
      For J = 2 To Sheets(I).Range("A65000").End(xlUp).Row - 1 'Boucle sur ligne feuille
            If Sheets(I).Cells(J, 2) = "" Then 'S'il s'agit d'une cellule fusionnée
                X = J + 1
            Else
                Y = J
                If X <> Y Then
                    For K = X To Y
                        'Vérification si K et K+1 sont identiques
                        If Sheets(I).Cells(K, 1) = Sheets(I).Cells(K + 1, 1) _
                        And Sheets(I).Cells(K, 16) = Sheets(I).Cells(K + 1, 16) Then
 
                        'Concaténation colonne dimensions
                            'Découpe la chaine en fonction des " / " (Z) : Le résultat de la fonction Split est stocké dans un tableau
                            Tableau1 = Split(Sheets(I).Cells(K, 8), Z)
                            Tableau2 = Split(Sheets(I).Cells(K + 1, 8), Z)
                            Sheets(I).Cells(K, 11) = Val(Replace(Sheets(I).Cells(K, 11), ",", ".")) + _
                            Val(Replace(Sheets(I).Cells(K, 11), ",", ".")) 'Poids total
                            Sheets(I).Cells(K, 11).NumberFormat = "0.000\ t"
                            Sheets(I).Cells(K, 10).NumberFormat = "0"
 
                        'Concaténation colonne remarques
                            If InStr(Sheets(I).Cells(K, 12), Z) <> 0 Then
                                'Découpe la chaine en fonction des " / " (Z) : Le résultat de la fonction Split est stocké dans un tableau
                                Tableau1 = Split(Sheets(I).Cells(K, 12), Z)
                                'Boucle sur le tableau pour tester le résultat
                                W = 0
                                For L = 0 To UBound(Tableau1)
                                    If Tableau1(L) = Sheets(I).Cells(K + 1, 12) Then W = 1
                                Next L
                                If W = 0 And Sheets(I).Cells(K + 1, 12) <> "" Then Sheets(I).Cells(K, 12) = _
                                Sheets(I).Cells(K, 12) & Z & Sheets(I).Cells(K + 1, 12)
                            Else
                                If Sheets(I).Cells(K, 12) <> Sheets(I).Cells(K + 1, 12) And Sheets(I).Cells(K + 1, 12) <> "" Then
                                    If Sheets(I).Cells(K, 12) <> "" Then
                                        Sheets(I).Cells(K, 12) = Sheets(I).Cells(K, 12) & Z & Sheets(I).Cells(K + 1, 12)
                                    Else
                                        Sheets(I).Cells(K, 12) = Sheets(I).Cells(K + 1, 12)
                                    End If
                                End If
                            End If
                            Sheets(I).Cells(K, 12) = Replace(Sheets(I).Cells(K, 12), " /  / ", Z)
 
                        'Concaténation colonne localisation
                            If InStr(Sheets(I).Cells(K, 13), Z) <> 0 Then
                                'Découpe la chaine en fonction des " / " (Z) : Le résultat de la fonction Split est stocké dans un tableau
                                Tableau1 = Split(Sheets(I).Cells(K, 13), Z)
                                'Boucle sur le tableau pour tester le résultat
                                W = 0
                                For L = 0 To UBound(Tableau1)
                                    If Tableau1(L) = Sheets(I).Cells(K + 1, 13) Then W = 1
                                Next L
                                If W = 0 And Sheets(I).Cells(K + 1, 13) <> "" Then Sheets(I).Cells(K, 13) = _
                                Sheets(I).Cells(K, 13) & Z & Sheets(I).Cells(K + 1, 13)
                            Else
                                If Sheets(I).Cells(K, 13) <> Sheets(I).Cells(K + 1, 13) And Sheets(I).Cells(K, 13) <> "" Then
                                    If Sheets(I).Cells(K, 13) <> "" Then
                                        Sheets(I).Cells(K, 13) = Sheets(I).Cells(K, 13) & Z & Sheets(I).Cells(K + 1, 13)
                                    Else
                                        Sheets(I).Cells(K, 13) = Sheets(I).Cells(K + 1, 13)
                                    End If
                                End If
                            End If
                            'Sheets(I).Cells(K, 13) = Replace(Sheets(I).Cells(K, 13), " /  / ", Z)
                        'Concaténation colonne ID Saisie
                            Sheets(I).Cells(K, 15) = Sheets(I).Cells(K, 15) & "/" & Sheets(I).Cells(K + 1, 15)
                        'Suppression de la ligne K+1 si identique à K, après concaténation des données sur K
                            Rows(K + 1 & ":" & K + 1).Delete Shift:=xlUp
                         '-----------------------------
                            K = K - 1
                         '---------------------------
                        End If
                    Next K
                End If
            End If
       Next J
Next I

J'espère être assez clair

Merci d'avance

**SfJ5Rpw8** · 23/04/2015, 18h06

bonjour,

déjà dans une boucle for c'est une mauvaise idée de toucher à l'index il faut laisser sa gestion à l'instruction FOR ...

dans la plus part des cas lorsqu'il s'agit de supprimer des lignes, le mieux est de parcourir le tableau de bas en haut ainsi on ne subit pas de problèmes du aux décalages des lignes suite à la suppression de l'une d'entre-elle....(vu qu'on supprime la ligne la plus basse...)

**bickou** · 23/04/2015, 18h37

Bonjour bbil,

Merci du conseil,

Je viens de tester rapidement effectivement ça ne plante plus

Bon par contre le problème que j'avais cru déjà percevoir semble se confirmer également dans ce cas.
Le filtrage des données ne fonctionne que sur le dernier onglet créé. Ce que je ne comprend pas car l'ensemble de mon code doit être réalisé sur chaque itération de I (onglet).

Je vais essayer de continuer d'adapter le code peut-être que c'est car je pars à l'envers cette fois.

Je vous tiens au courant de mon avancée.

**Theze** · 23/04/2015, 20h39

Bonsoir,

Pour le contrôle de cellules fusionnées :

Code :

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

1
2
 
If Sheets(I).Cells(J, 2) = "" Then 'S'il s'agit d'une cellule fusionnée

c'est plutôt de cette façon :

Code :

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

1
2
 
If Sheets(I).Cells(J, 2).MergeCells Then

Le filtrage des données ne fonctionne que sur le dernier onglet créé. Ce que je ne comprend pas car l'ensemble de mon code doit être réalisé sur chaque itération de I (onglet).

Attention, quand tu utilise les index de feuilles, il faut savoir qu'ils ne sont pas figés et attribués à chaque feuille de façon définitive. L'index commence à 1 pour la feuille la plus à gauche (dans la collection d'onglets en bas à gauche) et fini à Sheets.Count pour la plus à droite (toujours dans la collection d'onglets) et si tu as déplacé des feuilles (dans les onglets toujours) elles changent d'index et peut être que tu pense faire référence à certaines feuilles en particulier mais comme elles ont été déplacées, elles ne sont plus prisent en considération dans la boucle car tu commence à 7.
Tu peux contrôler le nom des feuilles et leur index avec cette simple proc (résultat dans la fenêtre d'exécution :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub Test()
 
    Dim I As Integer
 
    For I = 1 To Sheets.Count
 
        Debug.Print "Nom de la feuille : " & Sheets(I).Name; " et index de cette feuille : " & I
 
    Next I
 
End Sub

Hervé.

**bickou** · 23/04/2015, 23h08

Merci These pour ce conseil,

Mes feuilles sont dans le bon ordre je viens de vérifier.

J'avais de toute façon intégré de positionner la nouvelle feuille créé à la fin.

Bon en tout cas je confirme que mon problème persiste : dès que j'ai plus d'un bâtiment le code ne fais pas ce que j'attends.

En effet, il ne supprime plus les lignes en double sur ma feuille 1 et il en supprime trop que la feuille 2.

Je comprends vraiment pas pourquoi ça ne fonctionne pas

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
Dim I As Integer, J As Integer, K As Integer, L As Integer, M As Integer 'Variables de boucles
Dim x As Integer, y As Integer, W As Integer 'Variables comparatives
Dim Tableau1() As String, Tableau2() As String 'Variables tableaux
Dim Z As String 'Variable simplificatrice
 
'Demander si fusion ou non des lignes similaires : Si oui attention perte de données des dimensions non utilisées par la formule
Rep2 = MsgBox("Souhaitez vous fusionner les ouvrages de même typologie ?" & vbLf & _
"Attention perte de données des dimensions non utilisées par la formule", vbYesNo, "Fusion des données")
 
'Boucle sur feuille
For I = 7 To Sheets.Count
    'Fusion des lignes similaires sur réponse oui au msgbox
    If Rep2 = vbYes Then
        Z = " / "
        x = Sheets(I).Range("A65000").End(xlUp).Row
        For K = x To 3 Step -1 'Boucle sur ligne feuille
            'Vérification si K et K-1 sont identiques
            If Sheets(I).Cells(K, 1) = Sheets(I).Cells(K - 1, 1) _
            And Sheets(I).Cells(K, 2) = Sheets(I).Cells(K - 1, 2) _
            And Sheets(I).Cells(K, 3) = Sheets(I).Cells(K - 1, 3) _
            And Sheets(I).Cells(K, 4) = Sheets(I).Cells(K - 1, 4) _
            And Sheets(I).Cells(K, 5) = Sheets(I).Cells(K - 1, 5) _
            And Sheets(I).Cells(K, 6) = Sheets(I).Cells(K - 1, 6) _
            And Sheets(I).Cells(K, 7) = Sheets(I).Cells(K - 1, 7) _
            And Sheets(I).Cells(K, 9) = Sheets(I).Cells(K - 1, 9) _
            And Sheets(I).Cells(K, 10) = Sheets(I).Cells(K - 1, 10) _
            And Sheets(I).Cells(K, 16) = Sheets(I).Cells(K - 1, 16) Then
            'Concaténation colonne dimensions
                'Découpe la chaine en fonction des " / " (Z) : Le résultat de la fonction Split est stocké dans un tableau
                Tableau1 = Split(Sheets(I).Cells(K, 8), Z)
                Tableau2 = Split(Sheets(I).Cells(K - 1, 8), Z)
                Select Case Sheets(I).Cells(K, 16)
                    Case "d*Qte", "m*Qte"
                        'Scinder les dimensions pour ne prendre que Qte sur ligne K
                            For L = 0 To UBound(Tableau1)
                                If InStr(Tableau1(L), "Q") Then
                                Tableau1(L) = Replace(Tableau1(L), ",", ".")
                                Tableau1(L) = Replace(Tableau1(L), " ", "x")
                                For M = 1 To Len(Tableau1(L))
                                    If IsNumeric(Mid(Tableau1(L), M, 1)) Then
                                        Sheets(I).Cells(K, 8) = Val(Mid(Tableau1(L), M, Len(Tableau1(L)) - M + 1))
                                    End If
                                Next M
                                End If
                            Next L
                        'Scinder les dimensions pour ne prendre que Qte sur ligne K-1
                            For L = 0 To UBound(Tableau2)
                                If InStr(Tableau2(L), "Q") Then
                                Tableau2(L) = Replace(Tableau2(L), ",", ".")
                                Tableau2(L) = Replace(Tableau2(L), " ", "x")
                                For M = 1 To Len(Tableau2(L))
                                    If IsNumeric(Mid(Tableau2(L), M, 1)) Then
                                        Sheets(I).Cells(K - 1, 8) = Val(Mid(Tableau2(L), M, Len(Tableau2(L)) - M + 1))
                                    End If
                                Next M
                                End If
                            Next L
                        'Associer la valeur K + K-1 que ligne K-1
                        Sheets(I).Cells(K - 1, 8) = Val(Sheets(I).Cells(K, 8)) + Val(Sheets(I).Cells(K - 1, 8))
                        Sheets(I).Cells(K - 1, 8).NumberFormat = "#,##0"
                        Sheets(I).Cells(K - 1, 8) = "Qte " & Sheets(I).Cells(K - 1, 8) & "u"
                    Case "L*d"
                        For L = 0 To UBound(Tableau1)
                            If InStr(Tableau1(L), "L") Then
                            Tableau1(L) = Replace(Tableau1(L), ",", ".")
                            Tableau1(L) = Replace(Tableau1(L), " ", "x")
                            For M = 1 To Len(Tableau1(L))
                                If IsNumeric(Mid(Tableau1(L), M, 1)) Then
                                    Sheets(I).Cells(K, 8) = Val(Mid(Tableau1(L), M, Len(Tableau1(L)) - M + 1))
                                End If
                            Next M
                            End If
                        Next L
                        For L = 0 To UBound(Tableau2)
                            If InStr(Tableau2(L), "L") Then
                            Tableau2(L) = Replace(Tableau2(L), ",", ".")
                            Tableau2(L) = Replace(Tableau2(L), " ", "x")
                            For M = 1 To Len(Tableau2(L))
                                If IsNumeric(Mid(Tableau2(L), M, 1)) Then
                                    Sheets(I).Cells(K - 1, 8) = Val(Mid(Tableau2(L), M, Len(Tableau2(L)) - M + 1))
                                End If
                            Next M
                            End If
                        Next L
                        Sheets(I).Cells(K - 1, 8) = Val(Sheets(I).Cells(K, 8)) + Val(Sheets(I).Cells(K - 1, 8))
                        Sheets(I).Cells(K - 1, 8).NumberFormat = "#,##0.0"
                        Sheets(I).Cells(K - 1, 8) = "L " & Sheets(I).Cells(K - 1, 8) & "m"
                End Select
                Sheets(I).Cells(K - 1, 11) = Val(Replace(Sheets(I).Cells(K, 11), ",", ".")) + Val(Replace(Sheets(I).Cells(K - 1, 11), ",", ".")) 'Poids total
                Sheets(I).Cells(K - 1, 11).NumberFormat = "0.000\ t"
                Sheets(I).Cells(K - 1, 10).NumberFormat = "0"
            'Concaténation colonne remarques
                W = 0
                If Sheets(I).Cells(K, 12) <> "" Then
                    Tableau1 = Split(Sheets(I).Cells(K, 12), Z)
                    'Boucle sur le tableau pour tester le résultat
                    For L = 0 To UBound(Tableau1)
                        If Tableau1(L) = Sheets(I).Cells(K - 1, 12) Then W = 1
                    Next L
                    If W = 0 And Sheets(I).Cells(K - 1, 12) <> "" Then Sheets(I).Cells(K - 1, 12) = Sheets(I).Cells(K, 12) & Z & Sheets(I).Cells(K - 1, 12)
                End If
            'Concaténation colonne localisation
                W = 0
                If Sheets(I).Cells(K, 12) <> "" Then
                    Tableau1 = Split(Sheets(I).Cells(K, 13), Z)
                    'Boucle sur le tableau pour tester le résultat
                    For L = 0 To UBound(Tableau1)
                        If Tableau1(L) = Sheets(I).Cells(K - 1, 13) Then W = 1
                    Next L
                    If W = 0 And Sheets(I).Cells(K - 1, 13) <> "" Then Sheets(I).Cells(K - 1, 13) = Sheets(I).Cells(K - 1, 13) & Z & Sheets(I).Cells(K, 13)
                End If
            'Concaténation colonne ID Saisie
                Sheets(I).Cells(K - 1, 15) = Sheets(I).Cells(K - 1, 15) & "/" & Sheets(I).Cells(K, 15)
            'Suppression de la ligne K si identique à K-1, après concaténation des données sur K-1
                Rows(K & ":" & K).Delete 'Shift:=xlUp
            End If
        Next K
    End If
Next I

Et je confirme que ça marche très bien si je n'ai que 1 feuille à traiter.

Je rectifie mon commentaire précédent : quand j'ai plusieurs feuilles la concaténation sur K-1 fonctionne mais plus la suppression de la ligne K. J'ai le résultat suivant
Ligne 1 : H / G / F / E : ligne à conserver
Ligne 2 : G / F / E
Ligne 3 : F / E
Ligne 4 : E
Ligne 5 : D / C / B / A : ligne à conserver
Ligne 6 : C / B / A
Ligne 7 : B / A
Ligne 8 : A

Autre remarque :
Je n'utilise que des références feuille.cells donc pas de sélection, et le résultat change selon sur quelle feuille est mon activecell

**Theze** · 24/04/2015, 07h00

Bonjour,

Je n'utilise que des références feuille.cells donc pas de sélection, et le résultat change selon sur quelle feuille est mon activecell

En fin de proc tu as cette ligne de code où la ligne (Rows()) n'est rattachée à aucun parent :

Code :

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

1
2
 
Rows(K & ":" & K).Delete 'Shift:=xlUp

Donc, c'est appliqué par défaut sur la feuille active au moment du lancement de la proc.

Hervé.

**bickou** · 24/04/2015, 10h55

La voilà mon erreur !!!!!

Merci beaucoup Theze.

Un simple :

Code :

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

Sheets(I).Rows(K & ":" & K).Delete Shift:=xlUp

à résolu mon problème

Export vers autre onglet - Bug sur boucle origine inconnue [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager