Besoin d?une aide pour optimiser une macroRésolu

Question

Bonjour, J’ai besoin d’une aide pour optimiser une macro sur Excel 2003 : Cette macro delete des numéros de dossiers s’il y a les doublons. Dim i As Integer Dim varTour1 As Integer Dim varTour2 As Integer Dim noDoc As String Dim noRol As String 'Supprime les lignes dont les n° de dossiers sont identiques après la première ligne For varTour1 = 10 To 1500 '<= Nombre de lignes!!! noDoc = Worksheets(4).Range("A" & CStr(varTour1)).Value noRol = Worksheets(4).Range("D" & CStr(varTour1)).Value If noDoc = "" Then Exit For For varTour2 = 10 To 1500 If varTour1 <> varTour2 And _ noDoc = Worksheets(4).Range("A" & CStr(varTour2)).Value And _ noRol = "Contributeur" Then _ Worksheets(4).Range("A" & CStr(varTour1)).EntireRow.Delete Next varTour2 Next varTour1 Dans mon tableau je garde la première ligne par numéro de dossier et vérifie s"il en a d'autres si c'est le cas elles sont supprimées. Mais mon souci est que il reste des doublons et qu’il delete certains numéro de dossier. Je perds un temps fou à vérifier. Merci d’avances [?] Estelle[8D]

drikce06 · Accepted Answer

J'ai testé ça, je me suis pris la tête mais ça marche sur 10 et 20 lignes.
je teste sur plus, essaye déjà avec ça.

Dim i, j As Integer
Dim nodoc1, nodoc2 As String


For i = 1 To 20
   
   nodoc1 = ""
   nodoc1 = CStr(Worksheets(1).Range("A" & i).Value)
   
   If nodoc1 = "" Then
     Exit For
   End If


 For j = 1 To 20


   nodoc2 = ""
   nodoc2 = CStr(Worksheets(1).Range("A" & j).Value)
   
   If nodoc2 = "" Then
     Exit For
   End If


  If i <> j And j > i And nodoc1 = nodoc2 Then


Worksheets(1).Range("A" & j).EntireRow.Delete
j = j - 1


  End If


  Next j


Next i

 Drikce 06

drikce06 · Answer

Salut
Dans un premier temps je supprimerai ça CStr(varTour1) et CStr(varTour2).
Met varTour1 et varTour2 tout seul. Pourquoi tu les convertis en Sring, ça sert rien.

 Drikce 06

drikce06 · Answer

Ensuite je mettrai ça c'est plus sur.
If noDoc = ""  or IsEmpty(Worksheets(4).Range("A" & varTour1).Value) Then Exit For

 Drikce 06

drikce06 · Answer

Explique moi cette condition stp pour je comprenne mieux
    If varTour1 <> varTour2 And _

     noDoc = Worksheets(4).Range("A" & CStr(varTour2)).Value And _

     noRol = "Contributeur" Then _

si tu es arrivé la dans ton programme il y a forcément quelquechose dans noDoc vu qu'avant si'il y a rien tu sort du For donc tu peux supprimer noDoc = Worksheets(4).Range("A" & CStr(varTour2)).Value dans la condition

 Drikce 06

fitzjames · Answer

=> Les numéros de dossiers que je récupèrent peuvent être numériques ou alphanumériques ou alphabétiques....
Je sais pas trop comment faire.

[?] Estelle[8D]

drikce06 · Answer

Essaye ça pour voir

For i = 10 To 1500 '<= Nombre de lignes!!!

   noDoc1 = Worksheets(4).Range("A" & i).Value
   noRol = Worksheets(4).Range("D" & i).Value

  If noDoc = "" Then Exit For

 For j = 10 To 1500

noDoc2 = Worksheets(4).Range("A" & i).Value

  If  i <>j and noDoc1=noDoc2 Then 

Worksheets(4).Range("A" & j)).EntireRow.Delete



  Next j


Next i

 Drikce 06

drikce06 · Answer

pardon pour noDoc2 c'est j et pas i
noDoc2 = Worksheets(4).Range("A" & j).Value

 Drikce 06

fitzjames · Answer

varTour1 est la première ligne ou il y a le n° de dossier.
varTour2 est ou sont les lignes doublons.

En faite je teste pour un n° de dossier après la première ligne de ce dossier s'il y a le même n° de dossier,
Si oui il supprime la ligne autant de fois qu'il la rencontre.
Si non il passe à la ligne suivante.
J'essaye de garder toujours la première ligne.

Exemple:
Ligne 1 : 9a18 
Ligne 2 : 9a18 
Ligne3 : 9a18 
Je souhaiterai garder la ligne 1 à chaque numéro de dossier.

C'est plus claire ?

[?] Estelle[8D]

fitzjames · Answer

J'ai essayée : Dim noDoc1 As String Dim noDoc2 As String Dim noRol As String 'Supprime les lignes dont les n° de dossier sont identiques après la première ligne For i = 10 To 1500 '<= Nombre de lignes!!! noDoc1 = Worksheets(4).Range("A" & i).Value noRol = Worksheets(4).Range("D" & i).Value If noDoc1 = "" Then Exit For For j = 10 To 1500 noDoc2 = Worksheets(4).Range("A" & j).Value If i <> j And noDoc1 = noDoc2 Then Worksheets(4).Range("A" & j).EntireRow.Delete Next j Next i Et la macro ci dessus fait le même résultats que : Dim i As Integer Dim varTour1 As Integer Dim varTour2 As Integer Dim noDoc As StringDim noRol As String 'Supprime les lignes dont les n° de dossiers sont identiques après la première ligne For varTour1 = 10 To 1500 '<= Nombre de lignes!!! noDoc = Worksheets(4).Range("A" & CStr(varTour1)).Value noRol = Worksheets(4).Range("D" & CStr(varTour1)).Value If noDoc = "" Then Exit For For varTour2 = 10 To 1500 If varTour1 <> varTour2 And _ noDoc = Worksheets(4).Range("A" & CStr(varTour2)).Value And _ noRol = "Contributeur" Then _ Worksheets(4).Range("A" & CStr(varTour1)).EntireRow.Delete Next varTour2 Next varTour1 je souhaiterai toujours garder la 1ère ligne et supprimer celles d'en desous. Merci encore [?] Estelle[8D]

drikce06 · Answer

Précise
noDoc1 = Cstr(Worksheets(4).Range("A" & i).Value)
noDoc2 = Cstr(Worksheets(4).Range("A" & j).Value)

Au moins tu es sure qu'il va comparer deux chaines de caractères.

 Drikce 06

fitzjames · Answer

Oui il compare les 2 chaines de caractères. 
mais j'ai toujours des doublons et la macro supprime quelques n° de dossier.
j'avais essayer aussi 
1500 To 10 Step-1 mais ça marche pas.
merci
[?] Estelle[8D]

drikce06 · Answer

ça marche bien même sur 100 lignes et même sur 1000.

 Drikce 06

cs_ordino · Answer

ORDINO[size=3]ORDINO/size=3

fitzjames · Answer

ça marche nickel merci encore même avec 3000 lignes.

[?] Estelle[8D]

drikce06 · Answer

Tu peux également remplacer cette condition :
 If i <> j And j > i And nodoc1 = nodoc2 Then
par:
 If  j > i And nodoc1 = nodoc2 Then
ça revient au même et du coup l'execution sera plus rapide même si c'est déjà rapide

 Drikce 06

Besoin d?une aide pour optimiser une macro

15 réponses

Votre réponse

Discussions similaires