For Each objCell in Range

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai un comportement assez bizarre de mon For Each :aie:

Je mets le morceau de code pour que ce soit plus clair :
Code:

1 2 3 4 5 6 For Each objCell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown)) 'Si il y'a la valeur "archive" If objCell = "archive" Then 'Couper coller de la ligne dans une autre feuille End If Next
Et il se passe qqch de bizarre :D

J'ai rajouté un MsgBox(objCell.Address) avant le If pour en etre certain mais voilà ce que se passe.

La colonne nommé est la colonne Q
Dans cette colonne il y a tjs une formule donc mon range sélectionne de Q2 à la dernière ligne remplie.

Lorsque dans Q2, Q3, Q6 et Q7 j'ai la valeur "archive", mon message box me disant à quel cellule il en est pour le For m'affiche :
Q2
Q4
Q5
Q6
Q7
Q8
Q9
Q10

Mais où est passé Q3 ??
Je me suis dit que je devais avoir un problème dans mon code quand 2 lignes à traiter se suivait mais apparemment le soucis se pose que pour Q2 et Q3. Quand je teste avec des valeurs qui se suivent pour Q3 et Q4, et Q6 et Q7 ça marche très bien ...

Si qqn veut se casser la tête avec moi, voici le fichier joint au sujet. Le code se trouve dans le module 2 et dans la fonction archiver_lignes. Cette macro est lancé quand je clique sur le bouton à côté de "Ajouter Ligne". Vous inquiétez pas je vais pas vous laisser plancher tout seul si je trouve la solution je viendrais la poster aussi !

Pour les plus impatients voilà la fonction en entier (je sens que vous êtes impatients !! :yaisse2:).
Code:

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 Sub archiver_lignes() 'Tableau pour les lignes à supprimer Dim a_supprimer() As Integer Dim ind As Integer ind = 1 Worksheets("Dde EDI - NEOPOST").Select 'Pour toutes les cellules de la colonne Test archive 'Attention le range fonctionne car dans touts les cellules de cette colonne il y a une formule For Each objCell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown)) MsgBox (objCell.Address) 'Si il y'a la valeur "archive" If objCell = "archive" Then 'Séléction de la ligne concerné Rows(objCell.Row & ":" & objCell.Row).Select 'Sauvegarde des lignes à supprimer ReDim Preserve a_supprimer(ind) a_supprimer(ind) = objCell.Row ind = ind + 1 'Couper Selection.Cut 'Sélection de la feuille d'archive Worksheets("Archive EDI - NEOPOST").Select 'Aller à la fin If Range("A2") <> "" Then Range("A1").End(xlDown).Offset(1, 0).Select Else Range("A2").Select End If 'Coller ActiveSheet.Paste 'Retour à la feuille des demandes Worksheets("Dde EDI - NEOPOST").Select End If Next 'S'il y a des lignes à supprimer If ind > 1 Then 'Boucle pour supprimer les lignes 'En partant de la fin pour pas tout décaler For ind = UBound(a_supprimer) To 1 Step -1 Rows(a_supprimer(ind) & ":" & a_supprimer(ind)).Select Selection.Delete Shift:=xlUp Next End If End Sub
Merci

bonjour

tu n as pas declaré ton objcell et pr recupérer la valeur objcell.value
en tete de module ajoute option explicit pour obligatoirement declarer les variables

Code:

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
 
Sub archiver_lignes()
    'Tableau pour les lignes à supprimer
    Dim a_supprimer() As Integer
    Dim ind As Integer
    Dim objcell As Range 'declaration de l objet range
    Dim ws  As Worksheet
    ind = 1
 
    Set ws = Worksheets("Dde EDI - NEOPOST")
 
    'Pour toutes les cellules de la colonne Test archive
    'Attention le range fonctionne car dans touts les cellules de cette colonne il y a une formule
    For Each objcell In Range(Range("col_filter_edi").Cells(2, 1), Range("col_filter_edi").End(xlDown))
             'Si il y'a la valeur "archive"
        If objcell.Value = "archive" Then   'si c la valeur de la cellule a trouver
        MsgBox objcell.adress
            'Séléction de la ligne concerné
            Rows(objcell.Row & ":" & objcell.Row).Select
 
            'Sauvegarde des lignes à  supprimer
            ReDim Preserve a_supprimer(ind)
            a_supprimer(ind) = objcell.Row
            ind = ind + 1
 
            'Couper
            Selection.Cut
            'Sélection de la feuille d'archive
            Worksheets("Archive EDI - NEOPOST").Select
 
            'Aller à la fin
            If Range("A2") <> "" Then
                Range("A1").End(xlDown).Offset(1, 0).Select
            Else
                Range("A2").Select
            End If
 
            'Coller
            ActiveSheet.Paste
 
            'Retour à la feuille des demandes
            Worksheets("Dde EDI - NEOPOST").Select
 
 
        End If
    Next
 
    'S'il y a des lignes à supprimer
    If ind > 1 Then
        'Boucle pour supprimer les lignes
        'En partant de la fin pour pas tout décaler
        For ind = UBound(a_supprimer) To 1 Step -1
            Rows(a_supprimer(ind) & ":" & a_supprimer(ind)).Select
            Selection.Delete Shift:=xlUp
        Next
    End If
End Sub

19/10/2007, 14h20
alsimbad

Citation:

Envoyé par abilon

il se passe qqch de bizarre

Citation:

Envoyé par abilon

J'ai un comportement assez bizarre

Citation:

Envoyé par abilon

Je me suis dit que je devais avoir un problème

Citation:

Envoyé par abilon

Vous inquiétez pas

dans ton code
bon, :mouarf3:, je t'ai retrouvé ton q3, j'ai rien demandé, j'ai tapé F8 dans ton code. a preuve :
19/10/2007, 14h32
alsimbad

hé ben , je te demande pardon. j'ai réussi en modifaint ta formule pour que la valeur soit ("archive, puis en l'incrémentant a faire en sorte que dans le fichier joint l'erreur soit plus flagrant. pour le moment, j'ai pas la solution, mais je cherche, ne serais que pour m'etre moqué
19/10/2007, 15h09
abillon

ok :D,

Du coup après avoir vu ton message j'ai repassé en boucle le truc en me disant mais comment ça se fait que lui le voit et pas moi :mrgreen:

Merci de s'intéresser à mon petit problème !! Je planche toujours dessus :?. Dès que j'ai des nouvelles ou que j'ai trouvé la solution je posterai ! :)

[Edit]
Bon dans mon For Each au lieu de commencer à Q2, je commence à Q1 du coup ça marche. Mais bon ça me dit tjs pas pourquoi en commençant à Q2 ça fonctionne pas, surtout que je voudrais éviter de tester ma colonne de titre ...

je n'ai pas exactement réussi à determiner pourquoi la ligne 3, mais je suis presque sur que l'erreur vient de tes select. il faut vraiment l'éviter. ça fatigue les yeux et ça ralenti le code. du coup pour me faire pardonner de m'etre moqué de toi, je t'ai refait ton code, je pense que l'exemple pourras te servir pour modifier et améliorer un peu les autres patie de ta macro

Code:

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
 
Sub archiver_lignes()
    'Tableau pour les lignes à supprimer
    Dim a_supprimer() As Integer
    Dim ind As Integer
    ind = 1
    Set source = Worksheets("Dde EDI - NEOPOST")
    Set cible = Worksheets("Archive EDI - NEOPOST")
    derligne = source.Range("q65536").End(xlUp).Row
    Set zonesource = Range("q2:q" & derligne)
    'Pour toutes les cellules de la colonne Test archive
      For Each objCell In zonesource
        'Si il y'a la valeur "archive"
        lignecible = cible.Range("A65536").End(xlUp).Row + 1
        If objCell.Value = "archive" Then
           objCell.EntireRow.Copy (cible.Rows(lignecible))
            'Sauvegarde des lignes à  supprimer
            ReDim Preserve a_supprimer(ind)
            a_supprimer(ind) = objCell.Row
            ind = ind + 1
        End If
    Next objCell
    'S'il y a des lignes à supprimer
    If ind > 1 Then
        'Boucle pour supprimer les lignes
        'En partant de la fin pour pas tout décaler
        For ind = UBound(a_supprimer) To 1 Step -1
            source.Rows(a_supprimer(ind)).Delete
        Next
    End If
End Sub

petits conseil
n'oublie pas de déclarer tes variables, ne serais que pour y voir clair
n'utilise pas les select. il n'y a que les tris, je crois qui obligent a l'utiliser)
ps : je l'ai testé un peu, mais bon, il reste surement des erreurs

22/10/2007, 11h20
abillon

ok merci je vais tester ça !!

J'ai commencé le VBA Excel il y a 2 semaines, donc je tatonne :D. C'est vrai que les Select font mal aux yeux mais si y'a d'autres solutions je suis preneur :).

EDIT :
Merci pour ta solution !! ça évite des clignotements de partout ! :D
J'ai modifié pour un peu le code pour intégrer les noms de colonnes !