Comparer des cellules et afficher différence

Version imprimable

Voir 40 message(s) de cette discussion en une page

Même remarque pour le 110 et le 11 n'apparait pas

Teste ce code s'il donne les lignes qui doivent rester

Bon, patience

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
Sub Preparation()
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Comparaison")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil2")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("AH1:AH" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AH1:AH" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AH2:AH" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    With .Range("AI2:AI" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$T$2:$T$" & LastLig & ",$T2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("AI1:AI" & LastLig).AutoFilter Field:=1, Criteria1:="X"
    If .Range("AI1:AI" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AI2:AI" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

12/08/2014, 14h06
lilmonie

Merci de prendre patience avec moi! je vais tester le code que tu viens de ma donner

Citation:

Envoyé par mercatog

Même remarque pour le 110 et le 11 n'apparait pas

Pour 110, ligne8<>ligne34 et ligne8<>ligne35 donc on garde ligne 8, ligne34 et ligne 35
Ligne9=ligne 35 donc on garde ligne 8 et ligne34

En disant 11, je suppose sur tu parle du 111? Si c'est le cas je ne l'ai pas traité dans mon fichier car je voulais juste montrer un exemple du tableau résultat

Après avoir testé le code voici ce que j'ai pu observer

Citation:

Envoyé par mercatog

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
    'On filtre sur les semaines différentes de Sem1 et de Sem2Ici le filtre ne se fait pas après test
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("AH1:AH" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd


    'On efface les lignes ne correspondants pas aux 2 semaines Le tableau apparait vide après cette boucle
    If .Range("AH1:AH" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AH2:AH" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False

    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    With .Range("AI2:AI" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$T$2:$T$" & LastLig & ",$T2)=2,""X"","""")"
        .Value = .Value
    End With

    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("AI1:AI" & LastLig).AutoFilter Field:=1, Criteria1:="X"
    If .Range("AI1:AI" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AI2:AI" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

17/08/2014, 20h36
mercatog

Bah il suffit de voir le contenu des variables Sem1 et Sem2, et si la disposition du fichier n'a pas changé! (ces semaines devraient être en colonne AH)

Comme quoi on teste à l'aveuglette
17/08/2014, 21h48
lilmonie

2 pièce(s) jointe(s)

Citation:

With ThisWorkbook.Worksheets("Feuil2")
'On efface la feuille de destination
.UsedRange.Clear

'On copie l'ensemble des données de la feuille source vers la feuille destination
ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")

'On filtre sur les semaines différentes de Sem1 et de Sem2
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("AH1:AH" & LastLig).AutoFilter Field:=34, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd 'J'ai modofié le num de colonne

'On efface les lignes ne correspondants pas aux 2 semaines
If .Range("AH1:AH" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AH2:AH" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.ShowAllData

'On marque par un X les lignes doublons (sur Ref et sur MEC)
With .Range("AI2:AI" & LastLig)
.Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$T$2:$T$" & LastLig & ",$T2)=2,""X"","""")"
.Value = .Value
End With

'On efface les lignes doublons (filtre sur les X de marquage
.Range("AI1:AI" & LastLig).AutoFilter Field:=35, Criteria1:="X" 'Jai modifié le num de colonne
End With

A ce niveau du code,

Citation:

If .Range("AI1:AI" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AI2:AI" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.ShowAllData

J'ai une erreur de ce type: Pièce jointe 153984
Pièce jointe 153985

Alors j'ai fait une recherche pour avoir la nouvelle dernière ligne mais j'obtiens la dernière ligne d'une feuille excel cad 1048576 au lieu de 23. De plus, j'ai remplacé LastLig par 23 mais aucun changement.
17/08/2014, 22h08
mercatog

Tu as combien de colonnes dans la colonne AH pour filtrer la colonne AH sur sa 34ème colonne?
17/08/2014, 22h29
lilmonie

Citation:

Envoyé par mercatog

Tu as combien de colonnes dans la colonne AH pour filtrer la colonne AH sur sa 34ème colonne?

je suis désolé mais je ne comprends pas ta question. Veux tu savoir le nombre de lignes que j'ai après lors de l'effacement des doublons?

Code:

.Range("AH1:AH" & LastLig).AutoFilter Field:=34, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd

J'ai mis AutoFilter Field:=34 car AH est la 34ème colonne pour filter sur cette colonne là(AH)
17/08/2014, 22h47
mercatog

Dans ce cas il faudra

Code:

.Range("A1:AH" & LastLig).AutoFilter Field:=34...

Ou bien laisser

Code:

.Range("AH1:AH" & LastLig).AutoFilter Field:=1...

Mais ce n'est pas là ton problème, le code que je t'avais fourni est fonctionnel mais tu as changé .Autofiltermode=false par .Showalldata

Donc, ce n'est plus kif kif!
17/08/2014, 23h28
lilmonie

1 pièce(s) jointe(s)

Alors j'ai pu modifier et ça fonctionne.
En masuqant les autres colonnes, j'ai ce résultat:
Pièce jointe 153992

Je te remercie et aussi merci pour ta patience!:):)
Après ce tri et la suppression des tableaux, comment faire pour mettre le résultat sous la forme du tableau que j'avais fait dans "Feuil2" ?
17/08/2014, 23h40
mercatog

Tu as les lignes concernées.
L'enregistreur de macro est ton guide.

Après, il faudra optimiser le code obtenu.

HI HI!

Alors j'ai essayer le code dans mon fichier réel et j'obtiens la même erreur dans mon poste 85.

Citation:

'On efface les lignes ne correspondants pas aux 2 semaines (colonne AY=colonne des semaines)
If .Range("AY1:AY" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AY2:AY" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False

L'erreur est la suivante: Erreur d'éxécution '1004': La méthode Delete de la classe Range a échoué

Voici le code:

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
 
Sub Bouton4_Comparer()
 
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Feuil2")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil3")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:AY" & LastLig).AutoFilter Field:=51, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AY1:AY" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AY2:AY" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    '.ShowAllData
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    With .Range("AZ2:AZ" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$W$2:$W$" & LastLig & ",$W2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("A1:AZ" & LastLig).AutoFilter Field:=52, Criteria1:="X"
    If .Range("AZ1:AZ" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AZ2:AZ" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    '.ShowAllData
End With
 
End Sub

MEC est bien en colonne W

Sem1 et Sem2 ont bien leur valeurs respectives

Les noms des feuilles sont bien entendu les bons.

Regardes par hasard ce code (sans changement)

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
Sub Bouton4_Comparer()
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Feuil2")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil3")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("AY1:AY" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AY1:AY" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AY2:AY" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("AZ2:AZ" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$W$2:$W$" & LastLig & ",$W2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("AZ1:AZ" & LastLig).AutoFilter Field:=1, Criteria1:="X"
    If .Range("AZ1:AZ" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AZ2:AZ" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

25/08/2014, 13h16
lilmonie

Merci:)
ok je vais regarder ça de près! j'avoue ne pas comprendre pourquoi j'avais une erreur^^

Même en retestant le code sur le fichier que je vous avais communiqué, il ne fonctionne plus car en fin d'éxécutuon j'ai un tableau qui vide alors qu'il y a une semaine ça fonctionnait très bien comme je vous vais montré^^

Citation:

Envoyé par mercatog

Regardes par hasard ce code (sans changement)

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
Sub Bouton4_Comparer()
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Feuil2")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil3")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("AY1:AY" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AY1:AY" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AY2:AY" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("AZ2:AZ" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$W$2:$W$" & LastLig & ",$W2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("AZ1:AZ" & LastLig).AutoFilter Field:=1, Criteria1:="X"
    If .Range("AZ1:AZ" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AZ2:AZ" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

Alors j'ai refais le test avec ton code mais déjà le 1er tri n'est pas fait (celui qui prend les semaines non sélectionnées).
J'ai énormément de lignes à traiter (sur une semaine g au minimum 5000lignes). Suite encore à un changement mes semaines sont dans la colonne AX du coup j'ai fait la modification dans le code en remplaçant les AY par AX et les AZ par AY mais le premier tri n'est pas fait!

25/08/2014, 16h05
mercatog

Fais un débogage par F8 et regarde chaque ligne ce qu'elle fait (regarde aussi les variables)
25/08/2014, 16h21
lilmonie
Citation:

Envoyé par mercatog

Fais un débogage par F8 et regarde chaque ligne ce qu'elle fait (regarde aussi les variables)

J'ai bien tout checker avec le débogage par F8! sem1 est bien = 33 et sem2 est bien = 35.
Mais j'ai testé ça et le tri a été fait (vu ta remarque précédente je me doute que ce test n'est pas bon).
Code:

1 2 3 LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row .Range("AX1:AX" & LastLig).AutoFilter Field:=50, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
Après quand je mets Field:=50, j'ai après une erreur sur le Delete. (effacer les lignes qui ne correspondent pas aux semaines sélectionnées)
25/08/2014, 16h45
mercatog

Bah si tu continues à patauger, je n'y peu rien

Dans une précédente réponse

Citation:

Tu as combien de colonnes dans la colonne AH pour filtrer la colonne AH sur sa 34ème colonne?

C'est grave
25/08/2014, 17h14
lilmonie

Autant pour moi, je viens de comprendre mon erreur!
Mais le 1er filtre ne se fait pas. Par debogage toutes les variables sont bonnes

Malheuresement je ne suis pas très bonne à ce niveau là!

J'ai bien vérifié chacune de mes variables et elles sont bonnes. Du coup, je ne comprends pas pourquoi le filtre sur les semaines non concernées n'est pas pris en compte.
Le code est axactement le même; j'ai adapté en fonction du nom de colonne où se trouve les numéros de semaine (colonne AH)

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

Dim LastLig As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Feuil2")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil3")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("AX1:AX" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd Le filtre n'est pas fait
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AX1:AX" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AX2:AX" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete toutes les lignes sont effacées vu que le filtre n'est pas pris en compte précedemment
    .AutoFilterMode = False
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("AY2:AY" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$W$2:$W$" & LastLig & ",$W2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("AY1:AY" & LastLig).AutoFilter Field:=1, Criteria1:="X"
    If .Range("AY1:AY" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AY2:AY" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

dsl de tourner autour du même sujet mais g beau chercher depuis hier soir mais je ne trouve pas pourquoi le filtre n'est pas fait sur la colonne AX

Sinon j'ai testé ce code dans mon fichier test (pas le principal) et il fonctionne bien. G le résultat souhaité (Tableau du post 89)

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
 
Sub Bouton1_Cliquer()
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Comparaison")
    Sem1 = .Range("A3")
    Sem2 = .Range("B3")
End With
 
With ThisWorkbook.Worksheets("Feuil2")
    'On efface la feuille de destination
    .UsedRange.Clear
 
    'On copie l'ensemble des données de la feuille source vers la feuille destination
    ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
 
    'On filtre sur les semaines différentes de Sem1 et de Sem2
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:AH" & LastLig).AutoFilter Field:=34, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
 
    'On efface les lignes ne correspondants pas aux 2 semaines
    If .Range("AH1:AH" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AH2:AH" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    '.ShowAllData
 
    'On marque par un X les lignes doublons (sur Ref et sur MEC)
    With .Range("AI2:AI" & LastLig)
        .Formula = "=If(COUNTIFS($B$2:$B$" & LastLig & ",$B2,$T$2:$T$" & LastLig & ",$T2)=2,""X"","""")"
        .Value = .Value
    End With
 
    'On efface les lignes doublons (filtre sur les X de marquage
    .Range("A1:AI" & LastLig).AutoFilter Field:=35, Criteria1:="X"
    If .Range("AI1:AI" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AI2:AI" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
    '.ShowAllData
End With
 
End Sub

Voir 40 message(s) de cette discussion en une page