simplifier une procédure

Version imprimable

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

bonjour

j'ai un probleme
pour supprimer les doublons dans 5 feuilles je dois réiterer 5 fois 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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub dedoub()
 
Application.ScreenUpdating = False
Dim LastLig As Long, i As Long
 
 
With Sheets("PCH")
    LastLig = .Cells(.Rows.Count, "AF").End(xlUp).Row
    For i = LastLig To 2 Step -1
 
        If Application.CountIf(.Range("AF1:AF" & LastLig), .Range("AF" & i)) > 1 Then
            .Rows(i).Delete
            LastLig = LastLig - 1
        End If
    Next i
End With
 
With Sheets("EXP DIF")
    LastLig = .Cells(.Rows.Count, "AF").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If Application.CountIf(.Range("AF1:AF" & LastLig), .Range("AF" & i)) > 1 Then
            .Rows(i).Delete
            LastLig = LastLig - 1
        End If
    Next i
End With
 
With Sheets("RST")
    LastLig = .Cells(.Rows.Count, "AF").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If Application.CountIf(.Range("AF1:AF" & LastLig), .Range("AF" & i)) > 1 Then
            .Rows(i).Delete
            LastLig = LastLig - 1
        End If
    Next i
End With
 
With Sheets("AAR")
    LastLig = .Cells(.Rows.Count, "AF").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If Application.CountIf(.Range("AF1:AF" & LastLig), .Range("AF" & i)) > 1 Then
            .Rows(i).Delete
            LastLig = LastLig - 1
        End If
    Next i
End With
 
With Sheets("AAR35")
    LastLig = .Cells(.Rows.Count, "AF").End(xlUp).Row
    For i = LastLig To 2 Step -1
        If Application.CountIf(.Range("AF1:AF" & LastLig), .Range("AF" & i)) > 1 Then
            .Rows(i).Delete
            LastLig = LastLig - 1
        End If
    Next i
End With
End Sub

à chaque fois je dois réecris le traitement pour chaques feuilles

j'aimerai écrire une procédure qui fait appel aux 5 feuilles d'un coup allégeant ainsi la procédure en d'autre terme ecrire le traitement en une seule fois

NB: chaque feuilles n'a pas le même nombre de lignes pleines

voila merci d'avance

j'aimerais faire un traitement qui fait appel

Bonjour.

Tu peux faire la même chose mais avec une procédure élémentaire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub dedoub()
Application.ScreenUpdating = False
Call subDedoubleUne(ThisWorkbook.Worksheets("PCH"))
Call subDedoubleUne(ThisWorkbook.Worksheets("EXP DIF"))
Call subDedoubleUne(ThisWorkbook.Worksheets("RST"))
Call subDedoubleUne(ThisWorkbook.Worksheets("AAR"))
Call subDedoubleUne(ThisWorkbook.Worksheets("AAR35"))
Application.ScreenUpdating = True
End Sub
 
Sub subDedoubleUne(ByVal oSh As Excel.Worksheet)
Dim LastLig As Long, i As Long
 
LastLig = oSh.Cells(oSh.Rows.Count, "AF").End(xlUp).Row
For i = LastLig To 2 Step -1
    If Application.CountIf(oSh.Range("AF1:AF" & LastLig), oSh.Range("AF" & i)) > 1 Then
        oSh.Rows(i).Delete
        LastLig = LastLig - 1
    End If
Next i
 
End Sub

Mais bon, cela ne gagne rien en temps d'exécution...

PGZ

Ca peut t'aider ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 Sub Cleaner()
    Dim sh As Worksheet
 
    For Each sh In Worksheets(Array("AAR35", "AAR", "RST", "EXP DIF", "PCH"))
        sh.Select
        sh.Range("AF65000").End(xlUp).Select
        Do Until ActiveCell.Row = 1
            If Application.CountIf(sh.Columns("AF:AF"), ActiveCell.Value) > 1 Then
                ActiveCell.EntireRow.Delete
            Else
                'rien à faire
            End If
            ActiveCell.Offset(-1, 0).Select
        Loop
    Next
End Sub

[EDIT]
Zut !
C'est le cerveau qui est passé en premier !
:rire:
[/EDIT]

28/04/2011, 18h33
pgz

Bonjour Maxence

Citation:

Envoyé par Maxence HUBICHE

Zut !
C'est le cerveau qui est passé en premier !
:rire:

Bille en tête, en somme... :lefou:
C'est marrant j'avais aussi pensé à l'array, mais j'ai eu la flemme.

Amitiés,

PGZ
29/04/2011, 00h59
Maxence HUBICHE

Citation:

Envoyé par pgz

mais j'ai eu la flemme.

mais quelle flamme t'anime !
;)

Salut.

Mon grain de sel:
Il n'est pas nécessaire de sélectionner les feuilles et les cellules, c'est coûteux, surtout sans ScreenUpdating=False

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 Sub Cleaner()
    Dim sh As Worksheet
    Dim Ligne As Long
    For Each sh In Worksheets(Array("AAR35", "AAR", "RST"))
        Ligne = sh.Range("af" & sh.Rows.Count).End(xlUp).Row
        Do Until Ligne = 1
            If Application.CountIf(sh.Columns("AF:AF"), sh.Range("af" & Ligne).Value) > 1 Then
                sh.Range("a" & Ligne).EntireRow.Delete
            End If
            Ligne = Ligne - 1
        Loop
    Next
End Sub

29/04/2011, 08h09
Maxence HUBICHE

Tout à fait d'accord.
Je pense juste à l'utilisateur qui, s'il ne voit rien se produire, peu risquer de croire que "ça a planté"
Donc, même si c'est coûteux en temps processeur, je préfère lui "montrer" que ça marche.
Mais sur un plan purement dev., je suis d'accord à 100%

J'ajouterai que c'est ma faute...
J'avais mis en commentaire que c'était fait exprès pour montrer l'évolution du process à l'utilisateur... puis j'ai retiré le commentaire, ainsi que les commandes "hors sujet" comme Application.Interactive= False/True
29/04/2011, 09h59
huître

alors tout d'abord je tiens à vous remercier pour votre aide et c'est vrai que ça m'aide vraiment pour d'autres procédure

je sais que je vais être un peu chiant mais est ce qu'il y a moyen de faire en sorte que la procédure s'execute rapidement

merci d'avance
29/04/2011, 10h18
Pierre Fauconnier

Quelle version d'Excel?
29/04/2011, 10h57
huître

excel 2003
29/04/2011, 10h59
Maxence HUBICHE

Est-ce qu'il est possible de trier les données ?
Est-ce que ton tableau commence en A ?
29/04/2011, 11h14
huître

oui je pense qu'il est tout à fait possible de faire un tri mais le problème c'est que c'est un tableau contenant plusieurs dizaines de milliers de lignes par feuilles

en fait je dois faire un bouton de commande qui :
-fait appel à une msgbox demandant de choisir entre deux options

-importe des données d'une base odbs en respectant l'option choisie
-concatène deux champs et à partir du nouveau champs supprime les
doublons
-qui extrait les heures sous le format HH exemple 1945=>19 ou 945=>9 45=>00 5=>00
-qui compte ces heures et les reclasse dans un autre tableau qui va alimenter un graphique
-qui calcul la somme des poids pour chaque unités et alimente un autre tableau qui alimente a son tour un graphe

donc jusqu'ici toute les procédures ont été faites et fonctionnent correctement mais le problème c'est que ca prend 5-10 min lorsque je les lance toutes à partir du fameux bouton

donc là je suis entrain de tout restructurer pour alleger au maximum le processus et faire en sorte que environs 75 lignes de code en deviennent 30

pensez vous plutot que ca allegerer le programme??

je pense qu'en étant novice qui manipule du vba sur excel que depuis 3 semaines c'est pas gagner:traine:
29/04/2011, 11h26
Pierre Fauconnier

As-tu la main sur le sgbd que tu pilotes via odbc? Ce serait beaucoup plus simple et rapide de préparer la vue à la source et de l'importer "propre" dans Excel.
29/04/2011, 11h32
Maxence HUBICHE

5 à 10 mn, c'est déjà pas mal sur un tableur !
Surtout quand tu as plusieurs fois plusieurs milliers de lignes !

Si tu avais un vrai outil de gestion de données, tu pourrais supprimer les doublons dès l'import.
Mais avec Excel, tes scores sont déjà honorables.
Tu as en effet des goulots d'étranglements contre lesquels tu ne pourras pas grand chose :
- la qualité du réseau
- le volume de données à faire transiter (tu dis que le retour est tout paramétré, donc, c'est un côté non optimisable... hélas)
- la quantité de RAM du poste
- la qualité du moteur de traitement de données
- ...
Et puis les améliorations faisables, celles qui te restent, sont donc le code.
Mais là, à part la règle des 80/20 et un code propre, tu vas vite arriver à de l'incompressible eu égard à tes autres goulots d'étranglement.
29/04/2011, 11h35
huître

malheureusement je ne sais pas du tout manipuler l'odbs je fais simplement des liens directement via excel et puis j utilise l'instruction

"ActiveWorkbook.RefreshAll" dans le code vb

pour automatiser le traitement

mais ce que je peux faire c'est que je peux eventuellement retester tous les programmes hormis l'importation et les poster avec le nombre de temps que ça coute pour chacun des programmes et le temps que ca coute pour tout les programmes

non?

et puis pour repondre à la question on ne peut malheureusement pas supprimer les doublons à l'importation etant donnée qu'il n y a pas de clé
et puis les doublons sont exploitables pour d'autres applications
29/04/2011, 11h48
Maxence HUBICHE

les doublons ne peuvent pas être supprimés ?
Mais alors... pourquoi les supprimes-tu dans ta feuille ?
:koi:

D'autre part, tu dis que tu ne sais pas manipuler ton SGBDO (c'est ODBS en français, car
ODBS = Object DataBase System
et
SGBDO = Systeme de Gestion de Bases de Données Objet)
Mais par contre, est-possible ?
Si oui, y a-t-il quelqu'un dans l'entreprise qui pourrait te faire cette requête qui expurge déjà les lignes que tu veux supprimer dans Excel.
C'est l'optimisation majeure que tu pourrais faire. (ce vers quoi te dirige Pierre en fait :))
Si tout cela est irréalisable, alors on retombe dans ce que j'avais cru comprendre : que l'intervention sur l'odbs n'est pas possible... hélas !
29/04/2011, 11h50
Pierre Fauconnier

Il ne s'agit pas de supprimer les doublons à la source, bien sûr, mais de préparer une vue qui expose les données sans doublons sur le(s) champ(s) souhaité(s) (l'équivalent de la colonne AF). Tu rapatries alors dans Excel les données de la vue.

donc en faite de faire un liens avec une requete qui supprime les doublons lors de l'importation uniquement c'est bien ca??

Ben je pense que je vais me renseigner aupres du personnel spécialisé dans ce domaine

merci

sinon j'aurais une derniere requête alors j'ai allegé le programme suivant
(nb:si je resume c'est une procédure que j'ai copier coller 5 fois

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
Sub compteur1()
Dim derligne As Long
derligne = Sheets("AAR").Range("af65536").End(xlUp).Row
For i = 2 To derligne
For j = 4 To 27
If Cells(1, j) = Sheets("AAR").Cells(i, 32) Then
Cells(2, j) = Cells(2, j) + 1
End If
Next j
Next i
End Sub
Sub compteur2()
Dim derligne As Long
derligne = Sheets("AAR35").Range("af65536").End(xlUp).Row
For i = 2 To derligne
For j = 4 To 27
If Cells(1, j) = Sheets("AAR35").Cells(i, 32) Then
Cells(3, j) = Cells(3, j) + 1
End If
Next j
Next i
End Sub
Sub compteur3()
Dim derligne As Long
derligne = Sheets("PCH").Range("af65536").End(xlUp).Row
For i = 2 To derligne
For j = 4 To 27
If Cells(1, j) = Sheets("PCH").Cells(i, 32) Then
Cells(4, j) = Cells(4, j) + 1
End If
Next j
Next i
End Sub
Sub compteur4()
Dim derligne As Long
derligne = Sheets("EXP DIF").Range("af65536").End(xlUp).Row
For i = 2 To derligne
For j = 4 To 27
If Cells(1, j) = Sheets("EXP DIF").Cells(i, 32) Then
Cells(5, j) = Cells(5, j) + 1
End If
Next j
Next i
End Sub
Sub compteur5()
Dim derligne As Long
derligne = Sheets("RST").Range("af65536").End(xlUp).Row
For i = 2 To derligne
For j = 4 To 27
If Cells(1, j) = Sheets("RST").Cells(i, 32) Then
Cells(6, j) = Cells(6, j) + 1
End If
Next j
Next i
End Sub

le nouvelle procédure regroupe les 5 procédures

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub compteur()
Dim sh As Worksheet
    Dim Ligne As Long
    For Each sh In Worksheets(Array("AAR35", "AAR", "RST", "PCH", "EXP DIF"))
        Ligne = sh.Range("ae" & sh.Rows.Count).End(xlUp).Row
    For i = 2 To Ligne
    For j = 4 To 27
    For k = 2 To 6
    If Cells(k, 3) = sh.Name Then
        If Cells(1, j) = sh.Cells(i, 32) Then
        Cells(k, j) = Cells(k, j) + 1
        End If
    End If
    Next k
    Next j
    Next i
    Next sh
End Sub

alors le je fais une economie de 34 lignes mais la procedure met plus de temps à s'executer

est ce qu'il serait possible de faire en sorte que le precessus prend entre 10 et 20 seconde

29/04/2011, 12h22
Maxence HUBICHE

Citation:

Envoyé par huître

donc en faite de faire un liens avec une requete qui supprime les doublons lors de l'importation uniquement c'est bien ca??

Oui, exactement !
C'est le principal goulot d'étranglement, parce que, ce faisant, le traitement se fait côté serveur et il y a moins de données à faire transiter et à inscrire et donc tu n'as plus à les supprimer dans excel :)
29/04/2011, 12h34
huître

okok je te remercie

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