procédure recherche et suppression

Version imprimable

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

24/06/2011, 18h45
huître

Pardon j'ai fais une grosse erreur dans ma saisie

alors ce que je voulais dire :

Citation:

donc le but c'est de parcourir la feuille "feuilles-doublons" et de faire le traitement suivant:
si la clé ou doublons apparait en AAR et qu'elle est présente en EXP DIF ou en RST alors on la supprime en AAR ou en RST

le tableau DOUBLONS indique la présence ou non dans la clé dans telle ou telle feuille

ensuite EXP DEF c'est simplement une erreur de saisie

la feuille doublons est alimenté par une autre macro

voilà si tu as d'autres questions n'hésites pas
24/06/2011, 19h33
Philippe Tulliez

Bonsoir,

Citation:

si la clé ou doublons apparait en AAR et qu'elle est présente en EXP DIF ou la feuille RST alors on la supprime en AAR ou en RST

on la supprime en AAR ou en RST, qui prends cette décision ?
24/06/2011, 20h21
huître
zut décidement j'arrête pas de faire des erreurs de saisie

alors c'est impossible qu'une clé soit sur les 3 feuilles

une clé est toujours sur deux feuilles

donc si elle est en aar et en exp dif (cf feuille doublons) alors on la supprime de la feuille exp dif
si elle est en aar et en rst(feuille doublons) alors on(la macro) la supprime de la feuille rst

donc voila les deux cas possible

alors Mercatog ,

je suis entrain de tester ton code sur excel 2007

il marche nickel mais existe t il une maniere de le réadapter sous excel 2003

sinon je suis entrain de parcourir ton code ligne par ligne pour mieux le comprendre je n'ai pas compris la ligne
Code:

1 2 3 4 5 If j < N + 2 Then For m = j + 1 To N + 2 TabB(i, m) = 0 Next m End If
peux tu me l'expliquer stp

voilà
merci d'avance
27/06/2011, 12h14
mercatog

Bonjour Huitre.

Le code proposé a son utilité dans le filtre avec tableau ici

Code:

.Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:=Split(Str, "|"), Operator:=xlFilterValues

Malheureusement, cette fonctionalité n'est possible qu'à partir d'Excel 2007.
Le code tel adapté à Excel 2003, nécessite de faire une boucle de filtre avec comme critère chaque élément du tableau Split(Str, "|").

ce qui prendra un temps fou.

je me rappelle que tu travaille avec d'énormes quantités de données.
27/06/2011, 12h32
huître
Okok parceque j'ai compris ton algorithme et je le trouve super interessant
mais c'est dommage de ne pas pouvoir l'utiliser sous excel 2003

et sinon je n'ai tjr pas compris cette instruction
pourquoi mettre des 0 dans ce tableau?
Code:

1 2 3 4 5 If j < N + 2 Then For m = j + 1 To N + 2 TabB(i, m) = 0 Next m End If
27/06/2011, 12h37
mercatog

Si j'ai un 1 correspondant au doublon dans la feuille RST, je vais supprimer la donnée dans la feuille RST et si je laisse 1 dans TabB, dans la boucle suivante ça me supprimera aussi la ligne dans les autres feuilles.

Donc, si je supprime une ligne dans RST, je mettrai le compteur de doublons à 0 dans les autres feuilles.
27/06/2011, 13h32
huître

mais existe t il une autre manière de faire (avec ou sans filtre)???

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 SupprDoublons()
Dim LastLig As Long, i As Long, k As Long, T As Long
Dim N As Byte, j As Byte, m As Byte
Dim TabB, TabS, TabN()
Dim Str As String
 
T = Timer
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
TabS = Array("RST", "EXP-DIF", "AAR")            'LES COLONNES DE FEUILLES DOUBLONS DOIVENT ETRE ORGANISEES COMME CECI en B RST en C EXP-DIF et en D AAR
N = UBound(TabS)
With ThisWorkbook.Worksheets("Feuille-DOUBLONS")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    TabB = .Range(.Cells(1, 1), .Cells(LastLig, N + 2))
    For j = 2 To N + 2
        For i = 2 To LastLig
            If TabB(i, j) > 0 Then
                k = k + 1
                ReDim Preserve TabN(1 To 2, 1 To k)
                TabN(1, k) = TabB(i, 1)
                TabN(2, k) = TabB(1, j)
                If j < N + 2 Then
                    For m = j + 1 To N + 2
                        TabB(i, m) = 0
                    Next m
                End If
            End If
        Next i
    Next j
End With
'On boucle sur les feuilles RST,EXP et AAR et on recrée un tableau critère du filtre
For j = 0 To N
    For i = 1 To k
        If TabN(2, i) = TabS(j) Then Str = Str & "|" & TabN(1, i)
    Next i
    Str = Mid(Str, 2)
    If Len(Str) > 0 Then
        With Sheets(TabS(j))
            .AutoFilterMode = False
            LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
            For m = 0 To UBound(Split(Str, "|"))
                .Range("A1:A" & LastLig).AutoFilter Field:=1, Criteria1:=Split(Str, "|")(m)
                If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            Next m
            .AutoFilterMode = False
        End With
    End If
    Str = vbNullString
Next j
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
MsgBox "Traitement terminé en " & Timer - T & " secondes"
End Sub

Le temps d'exécution serait une éternité (j'ai pas testé)

27/06/2011, 14h19
huître

j'ai testé et j'obtiens

dépassement de capacité en erreur

mercatog,

est ce qu'il est possible de récuperer toutes les clés enfin en AAR et de voir si elle sont présentent en RST et en EXP DIF

et si c'est le cas de les supprimer

non et comment faire??
27/06/2011, 16h41
mercatog

Les supprimer de AAR ou de RST et de EXP-DIF?
27/06/2011, 21h10
huître

de les supprimer en RST et en EXP DIF

Lance la macro Suppression

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
Option Explicit
Private Sub Supression()
Dim i As Long, j As Long, k As Long
Dim tAAR, tRST, tEXP
 
Application.ScreenUpdating = False
tAAR = Worksheets("AAR").UsedRange.Value
tRST = Worksheets("RST").UsedRange.Value
tEXP = Worksheets("EXP-DIF").UsedRange.Value
k = Application.Max(UBound(tRST, 1), UBound(tEXP, 1))
For i = 2 To UBound(tAAR, 1)
    For j = 2 To k
        If j <= UBound(tRST, 1) Then tRST(j, 1) = IIf(tAAR(i, 1) = tRST(j, 1), Empty, tRST(j, 1))
        If j <= UBound(tEXP, 1) Then tEXP(j, 1) = IIf(tAAR(i, 1) = tEXP(j, 1), Empty, tEXP(j, 1))
    Next j
Next i
SuprDoub Worksheets("RST"), tRST
SuprDoub Worksheets("EXP-DIF"), tEXP
End Sub
 
Private Sub SuprDoub(Sh As Worksheet, Tb As Variant)
Dim LastLig As Long
 
With Sh
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .UsedRange.Value = Tb
    .UsedRange.AutoFilter Field:=1, Criteria1:="="
    If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

Mercatog

alors ton code fonctionne correctement sur le fichier de test

mais je ne comprend pas pourquoi ça ne marche pas quand j'essaye de le réadapter sur le fichier principale

normalement les clés se situe sur la 28 eme colonne

et quand je réadapte ça ne marche pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub SuprDoub(Sh As Worksheet, Tb As Variant) Dim LastLig As Long With Sh .AutoFilterMode = False LastLig = .Cells(.Rows.Count, 28).End(xlUp).Row .UsedRange.Value = Tb .UsedRange.AutoFilter Field:=1, Criteria1:="=" If .Range("AB1:AB" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AB2:AB" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.delete .AutoFilterMode = False End With End Sub
par ailleur que veut dire usedrang??

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
Private Sub Supression()
Dim i As Long, j As Long, k As Long
Dim tAAR, tRST, tEXP
 
Application.ScreenUpdating = False
tAAR = Worksheets("AAR").UsedRange.Value
tRST = Worksheets("RST").UsedRange.Value
tEXP = Worksheets("EXP-DIF").UsedRange.Value
k = Application.Max(UBound(tRST, 1), UBound(tEXP, 1))
For i = 2 To UBound(tAAR, 1)
    For j = 2 To k
        If j <= UBound(tRST, 1) Then tRST(j, 28) = IIf(tAAR(i, 28) = tRST(j, 28), Empty, tRST(j, 28))
        If j <= UBound(tEXP, 1) Then tEXP(j, 28) = IIf(tAAR(i, 28) = tEXP(j, 28), Empty, tEXP(j, 28))
    Next j
Next i
SuprDoub Worksheets("RST"), tRST
SuprDoub Worksheets("EXP-DIF"), tEXP
End Sub
 
Private Sub SuprDoub(Sh As Worksheet, Tb As Variant)
Dim LastLig As Long
 
With Sh
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .UsedRange.Value = Tb
    .UsedRange.AutoFilter Field:=28, Criteria1:="="
    If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

Tu n'as pas F1 sur ton clavier pour chercher l'aide sur Usedrange,

28/06/2011, 11h08
huître

ah génial tu assures Mercatog,

parcontre j'ai une nouvelle difficulté supplémentaire

j'ai rajouté deux autres feuilles AAR35 , PCH

est ce qu'il est possible de prendre à la fois les clé en AAR35, AAR et PCH
et de chercher si elle sont en EXP DIF et en RST pour les supprimer dans ces mm feuilles EXP DIF et RST
faire un truc comme ça??

Code:

If j <= UBound(tRST, 1) Then tRST(j, 28) = IIf(tAAR35AARPCH(i, 28) = tRST(j, 28), Empty, tRST(j, 28))
28/06/2011, 12h23
mercatog

Il ne suffit pas d'écrire n'importe quoi pour espérer aller vers l'avant
Que veut dire ceci

Code:

If j <= UBound(tRST, 1) Then tRST(j, 28) = IIf(tAAR35AARPCH(i, 28) = tRST(j, 28), Empty, tRST(j, 28))

Tu peux mettre un fichier exemple pour mon test avec toutes les feuilles et quelques donnée en colonne 28?
28/06/2011, 13h43
huître

alors mercatog ,

voilà le fichier , tu y trouveras les indications

Correction d'un bug

Essaies ceci

[Edit]

Après correction d'un bug

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
Private Sub Supression()
Dim i As Long, j As Long, k As Long, T As Long
Dim tAAR, tAAR35, tPCH, tRST, tEXP
Dim tSh() As String
 
Application.ScreenUpdating = False
T = Timer
tAAR = Worksheets("AAR").UsedRange.Value
tAAR35 = Worksheets("AAR35").UsedRange.Value
tPCH = Worksheets("PCH").UsedRange.Value
tRST = Worksheets("RST").UsedRange.Value
tEXP = Worksheets("EXP DIF").UsedRange.Value
 
ReDim tSh(1 To UBound(tAAR, 1) + UBound(tAAR35, 1) + UBound(tPCH, 1))
Rempl tAAR, tSh, 0
Rempl tAAR35, tSh, UBound(tAAR, 1)
Rempl tPCH, tSh, UBound(tAAR, 1) + UBound(tAAR35, 1)
 
k = Application.Max(UBound(tRST, 1), UBound(tEXP, 1))
For i = 2 To UBound(tSh)
    For j = 2 To k
        If j <= UBound(tRST, 1) Then
            If Not IsEmpty(tRST(j, 28)) Then tRST(j, 28) = IIf(tSh(i) = tRST(j, 28), Empty, tRST(j, 28))
        End If
        If j <= UBound(tEXP, 1) Then
            If Not IsEmpty(tEXP(j, 28)) Then tEXP(j, 28) = IIf(tSh(i) = tEXP(j, 28), Empty, tEXP(j, 28))
        End If
    Next j
Next i
SuprDoub Worksheets("RST"), tRST
SuprDoub Worksheets("EXP DIF"), tEXP
MsgBox "Terminé en " & Timer - T & " secondes."
End Sub
 
Private Sub Rempl(Tini As Variant, Tfin As Variant, Nini As Long)
Dim i As Long
 
For i = 1 To UBound(Tini)
    Tfin(Nini + i) = Tini(i, 28)
Next i
End Sub
 
Private Sub SuprDoub(Sh As Worksheet, Tb As Variant)
Dim LastLig As Long
 
With Sh
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    .UsedRange.Value = Tb
    .UsedRange.AutoFilter Field:=28, Criteria1:="="
    If .Range("A1:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("A2:A" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

28/06/2011, 14h46
huître

ben le debogueur me pointe sur cette ligne

Code:

If j <= UBound(tRST, 1) And Not IsEmpty(tRST(j, 28)) Then tRST(j, 28) = IIf(tSh(i) = tRST(j, 28), Empty, tRST(j, 28))

et puis lorsque je survole

Code:

tRST(j, 28))

j'obtiens le message suivant , l'indice n'appartient pas à la selection

pourtant je ne comprend pas ça marche bien sur le fichier testdoublons , je ne vois pas ce qui change par rapport au programme de référence mis à part l'ajout d'une feuille qui n'a aucun rapport avec la suppression de doublons
28/06/2011, 14h51
mercatog

Effectivement, il y avait un bug.
Regarde, j'avais édité le code.

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