Modification de code

Version imprimable

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

18/06/2015, 11h39
admdg

Modification de code

Bonjour à tous,

Ça fait quelques jours que je bloque sur une formule, je vous explique:
Je reçois un tableau Excel de taille différente (je ne connais pas le nombre de lignes), dont j'ai besoin d'extraire le nombre de "TPE" différents par semaine.

Parce que ce serait trop facile, la colonne où figure les numéros de TPE (type "TPE1501IBS00013", "TPE1501IBS00019" etc.) comprend d'autres références que je ne veux pas prendre en compte.

J'ai commencé par rédiger une formule avec SOMMEPROD qui compte le nombre de TPE dans les bornes de dates correspondantes avec les conditions de sommeprod et la fonction GAUCHE, mais ma formule ne fait que de me compter le nombre de TPE au total or il peut y en avoir une vingtaine avec la même référence, et je souhaiterai ne pas avoir de doublon dans mon résultat final...

Colonne I : dates des références
Colonne B et C : bornes de mes semaines (du 01/01/15 au 07/01/15 par exemple)
Colonne K : références
18/06/2015, 12h32
eric4459

Bonjour,
Il me semble que tu t'es trompé de forum à moins que tu ne veuilles créer une macro pour ton tri, tu devrais clore le sujet et poster ici:
http://www.developpez.net/forums/f54...-office/excel/
Par contre si tu as besoin d'aide pour le Vba tu es le bien venu ;)
Eric

Mince en effet ! Je me disais aussi il n'y a pas beaucoup de questions sur Excel-Excel !!

Bon puisque tu me proposes ton aide Eric je me suis mis en tête de résoudre mon problème via VBA :D

Une âme charitable m'a proposé le code suivant (qui marche nickel, un peu long à se lancer mais je ne vais pas faire la fine bouche)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub NbreDeTPE() Set plage = Range("K2:K" & Range("K" & 65536).End(xlUp).Row) For ln = 2 To Range("B" & 65536).End(xlUp).Row Set dico = CreateObject("Scripting.dictionary") For Each c In plage If c.Offset(0, -2) >= Cells(ln, "B") And c.Offset(0, -2) <= Cells(ln, "C") _ And Left(c.Value, 3) = "TPE" Then dico(c.Value) = "" End If Next c Cells(ln, "D").Value = dico.Count Next ln End Sub
Maintenant je me demandais comment est-ce que je pourrais rajouter une autre référence que "TPE", du genre "RE1". C'est à dire compter le nombre de références TPE et RE1 différentes dans une borne de temps. J'ai essayé comme un newbie de rajouter le code suivant mais les résultats n'ont pas été concluants...
Code:

1 2 3 4 If c.Offset(0, -2) >= Cells(ln, "B") And c.Offset(0, -2) <= Cells(ln, "C") _ And Left(c.Value, 3) = "RE1" Then dico(c.Value) = "" End If

1 pièce(s) jointe(s)

Bonjour Admdg,
On va voir ce que l'on peut-faire, mais avant tout quand tu veux poster du code, utilises les balises :tagcode: ;)

Pièce jointe 181034

et tu va voir c'est magique !!!
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub NbreDeTPE() Set plage = Range("K2:K" & Range("K" & 65536).End(xlUp).Row) For ln = 2 To Range("B" & 65536).End(xlUp).Row Set dico = CreateObject("Scripting.dictionary") For Each c In plage If c.Offset(0, -2) >= Cells(ln, "B") And c.Offset(0, -2) <= Cells(ln, "C") _ And Left(c.Value, 3) = "TPE" Then dico(c.Value) = "" End If Next c Cells(ln, "D").Value = dico.Count Next ln End Sub
JE vais regarder ton code et te recontacte ;)
Eric

19/06/2015, 11h22
admdg

Merci Eric (je viens de baliser mon post précédent ;)

Je te joins un fichier avec un exemple de ce que je voudrais, j'ai rajouté une petite difficulté qui n'est pas prise en compte dans le code présent: la colonne de référence et de date de référence ne sont pas sur la même feuille (feuil2) que celle où je souhaiterais les résultats (feuil1) :/

https://mon-partage.fr/f/65scyKC0/

2 pièce(s) jointe(s)

Rebonjour,
Voici un code qui a l'air de fonctionner, dis-moi si cela te convient ;)

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
Option Explicit
 
Sub Tri_TPE()
Dim TPE As Worksheet
Dim RSLT As Worksheet
Dim NbLigne As Integer
Dim i As Integer
Dim j As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A1")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = TPE.Range("K1")
Set Rng2 = Rng2.Offset(0)
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet
 
End With
 
 TPE.Range("$I$1:$K$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3) 'on enlève les doublons
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet après suppression des doublons
 
End With
 
 
For i = 0 To NbLigne
        If Rng2.Offset(i, 0) Like "*TPE*" Or Rng2.Offset(i, 0) Like "*RE1*" Then ' on recherche les lignes qui contiennent RE1 ou TPE
            For j = 0 To NbLigne
                If Rng2.Offset(i, -2) > Rng1.Offset(j, 1) And Rng2.Offset(i, -2) < Rng1.Offset(j, 2) Then 'Quand la ligne est trouvée on vérifie que la date correspondante ( Rng2.Offset(1, -2) ) est comprise dans
                Rng1.Offset(j, 3) = Rng1.Offset(j, 3) + 1                                                 'la période définie par les colonnes B et C de la feuille 1
                End If                                                                                    ' et on ajoute 1 au compteur colonne D feuille 1
            Next j
        End If
Next i
 
End Sub

Voici ton fichier modifié

Pièce jointe 181050

Eric

19/06/2015, 12h03
eric4459

1 pièce(s) jointe(s)

Attention,
L'un des deux fichiers fourni n'est pas correct.. boulette:oops:
Voici le bon
Pièce jointe 181052

Eric
19/06/2015, 13h19
admdg

Eric,

Je ne suis pas arrivé à télécharger tes fichiers, le message suivant s'affiche "Impossible d'ouvrir le fichier xxx car son format ou son extension n'est pas valide. Vérifiez que le fichier n'est pas endommagé et que son extension correspond bien au format du fichier." :/

Mais du coup j'ai copié le code que tu m'as passé et l'ai mis dans le fichier que je t'avais envoyé, et ça marche du tonnerre !! Cependant entre temps je me suis aperçu que j'étais passé à côté de quelque chose ... Je n'ai pas pris en compte une colonne qui figure dans mon fichier originel, (je te l'ai rajouté ici : https://mon-partage.fr/f/7lmsthIL/ )

La colonne F de la feuil2 correspond à des emplacements, or il ne me faut que le nombre de références TPE et RE1 (sans doublons du coup) de la colonne K, qui sont présents en emplacements "TR*". Mais comme tu peux voir ligne 182 on peut en trouver avec des emplacements "DO*" :/

Je ne sais pas si j'ai été assez clair, n'hésite pas à me demander des précisions

Et voilà le code avec le critère supplémentaire 8-)
Si tu analyse et comprends le code, tu verra que ça n'est pas si difficile que cela :pc: :arf: ;)

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
Option Explicit
 
Sub Tri_TPE()
Dim TPE As Worksheet
Dim RSLT As Worksheet
Dim NbLigne As Integer
Dim i As Integer
Dim j As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A1")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = TPE.Range("K1")
Set Rng2 = Rng2.Offset(0)
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet
 
End With
 
 TPE.Range("$I$1:$K$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3) 'on enlève les doublons
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet après suppression des doublons
 
End With
 
 
For i = 0 To NbLigne
        If (Rng2.Offset(i, 0) Like "*TPE*" Or Rng2.Offset(i, 0) Like "*RE1*") And Rng2.Offset(i, -5) Like "TR*" Then ' on recherche les lignes qui contiennent RE1 ou TPE et avec TR dans le code de l'emplacement
            For j = 0 To NbLigne
                If Rng2.Offset(i, -2) >= Rng1.Offset(j, 1) And Rng2.Offset(i, -2) <= Rng1.Offset(j, 2) Then 'Quand la ligne est trouvée on vérifie que la date correspondante ( Rng2.Offset(1, -2) ) est comprise dans
                Rng1.Offset(j, 3) = Rng1.Offset(j, 3) + 1                                                 'la période définie par les colonnes B et C de la feuille 1
                End If                                                                                    ' et on ajoute 1 au compteur colonne D feuille 1
            Next j
        End If
Next i
 
End Sub

Par contre j'ai un petit problème avec les compteurs, dans l'exemple que tu m'a envoyé en premier, je comptabilisais 22 lignes avec TR1 mais si je sommes les données par mois, j'arrive à 21.
J'ai vu que c'était en avril qu'il y avait un problème, on a 4 données en Avril mais dans le récap du mois on n'en compte que 3, le 30 avril n'est pas considéré dans le récap...
Je vais essayer de voir pourquoi...
Eric

Bon, j'ai trouvé
Il suffisait de modifier les conditions, à la place de la condition "Supérieur à" ou "Inférieur à"

Code:

If Rng2.Offset(i, -2) > Rng1.Offset(j, 1) And Rng2.Offset(i, -2) < Rng1.Offset(j, 2) Then

Jai modifié pour "Supérieur ou Egal à" ou "Inférieur ou Egal à"

Code:

If Rng2.Offset(i, -2) >= Rng1.Offset(j, 1) And Rng2.Offset(i, -2) <= Rng1.Offset(j, 2) Then

C'est mieux comme ça..;)

Eric

Merci de ton aide Eric c'est parfait !!

Je t'avoue que j'ai encore quelques divergences avec les données de mon fichier d'origine... Je vais continuer à me creuser la tête à trouver le paramètre manquant il doit y avoir quelque chose qui m’échappe, mais je pense avoir compris la technique maintenant pour rajouter des éléments ! ;)

J'ai trouvé d'où vient l'erreur:

Il se trouve qu'il faut que mon TPE ai également une référence "BIS*" ou "CA*" rattaché sur la même ligne mais en colonne K !!

Du coup j'ai essayé de rajouter cet élément dans le code mais je ne comprends pas pourquoi ça ne marche pas :'(

Est-ce qu'une erreur vous saute aux yeux ?

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
Sub methodesansemplacements()
Dim TPE As Worksheet
Dim RSLT As Worksheet
Dim BIS As Worksheet
Dim NbLigne As Integer
 
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set BIS = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A1")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = TPE.Range("K1")
Set Rng2 = Rng2.Offset(0)
Set Rng3 = BIS.Range("N1")
Set Rng3 = Rng3.Offset(0)
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet
 
End With
 
 TPE.Range("$i$1:$K$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3) 'on enlève les doublons
 
With TPE
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet après suppression des doublons
 
End With
 
 
For i = 0 To NbLigne
        If (Rng2.Offset(i, 0) Like "*TPE*" Or Rng2.Offset(i, 0) Like "*RE1*") And (Rng3.Offset(k, 0) Like "BIS*" or Rng3.Offset(k, 0)  Like "CA*") Then ' on recherche les lignes qui contiennent RE1 ou TPE ayant un code BIS 
            For j = 0 To NbLigne
                If Rng2.Offset(i, -2) > Rng1.Offset(j, 1) And Rng2.Offset(i, -2) < Rng1.Offset(j, 2) Then 'Quand la ligne est trouvée on vérifie que la date correspondante ( Rng2.Offset(1, -2) ) est comprise dans
                Rng1.Offset(j, 3) = Rng1.Offset(j, 3) + 1                                                 'la période définie par les colonnes B et C de la feuille 1
                End If                                                                                    ' et on ajoute 1 au compteur colonne D feuille 1
            Next j
        End If
Next i
 
End Sub

Je ne peux pas mettre de code balise dans mon message je dois passer par un serveur proxy pour aller sur le forum au travail :/ Je m'en excuse

Bonjour Admdg
Voici le code avec balise:

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
 
Sub methodesansemplacements()
Dim TPE As Worksheet
Dim RSLT As Worksheet
Dim BIS As Worksheet
Dim NbLigne As Integer
 
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set BIS = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A1")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = TPE.Range("K1")
Set Rng2 = Rng2.Offset(0)
Set Rng3 = BIS.Range("N1")
Set Rng3 = Rng3.Offset(0)
 
With TPE
 
NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row ' On compte le nombre de lignes de l'onglet
 
End With
 
TPE.Range("$i$1:$K$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3) 'on enlève les doublons
 
With TPE
 
NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row ' On compte le nombre de lignes de l'onglet après suppression des doublons
 
End With
 
 
For i = 0 To NbLigne
If (Rng2.Offset(i, 0) Like "*TPE*" Or Rng2.Offset(i, 0) Like "*RE1*") And (Rng3.Offset(k, 0) Like "BIS*" or Rng3.Offset(k, 0) Like "CA*") Then ' on recherche les lignes qui contiennent RE1 ou TPE ayant un code BIS 
For j = 0 To NbLigne
If Rng2.Offset(i, -2) > Rng1.Offset(j, 1) And Rng2.Offset(i, -2) < Rng1.Offset(j, 2) Then 'Quand la ligne est trouvée on vérifie que la date correspondante ( Rng2.Offset(1, -2) ) est comprise dans
Rng1.Offset(j, 3) = Rng1.Offset(j, 3) + 1 'la période définie par les colonnes B et C de la feuille 1
End If ' et on ajoute 1 au compteur colonne D feuille 1
Next j
End If
Next i
 
End Sub

Ce qui m'a frappé de suite c'est que tu déclares deux fois ta feuille 2 avec un nom différent:

Code:

1
2
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set BIS = ThisWorkbook.Sheets("Feuil2")

au lieu de cela tu devrais écrire:

Code:

1
2
3
4
5
6
7
8
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set TPE = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A1")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = TPE.Range("K1")
Set Rng2 = Rng2.Offset(0)
Set Rng3 = TPE.Range("N1")
Set Rng3 = Rng3.Offset(0)

Je n'ai pas testé, mais il semblerai que cela suffise.
Eric

23/06/2015, 15h20
joe.levrai
Bonjour,

on peut aussi éviter ces lignes, qui n'ont aucune utilité selon moi
Code:

1 2 Set Rng1 = Rng1.Offset(0) ' idem pour Rng2 et Rng3
je n'ai toujours pas compris cet automatisme dans tes codes eric4459, tu m'éclaires ? :oops:
23/06/2015, 16h58
eric4459

Salut Joe,
Je mets systématiquement ces lignes pour fixer ma référence, j'avais lu cela dans une réponse sur un forum ou dans un tuto, c'est devenu un automatisme mais c'est également vrai que l'on peut s'en passer.
Eric

Bonjour Eric et Joe

Merci pour vos réponses,

Eric ton code fonctionne à 100% !!

Petite question, "RSLT" que tu utilises pour déclarer la feuille 1, c'est juste des lettres que tu as mis histoire de déclarer la feuille ? Parce que je ne te vois pas le remettre par la suite.

Et si jamais vous ne doutiez pas encore de mes lacunes à VBA je vous joins mon fichier d'origine, épuré, sur lequel j'ai essayé en vain de transposer le code que tu m'as donné Eric dans ton dernier message...

https://mon-partage.fr/f/1mAFXLEw/

Mmh j'ai oublié de mettre le bon début dans le fichier partagé:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Dim i As Integer Dim j As Integer Dim k As Integer Dim Rng1 As Range Dim Rng2 As Range Dim Rng3 As Range Set RSLT = ThisWorkbook.Sheets("Feuil1") Set TPE = ThisWorkbook.Sheets("Feuil2") Set Rng1 = RSLT.Range("A1") Set Rng1 = Rng1.Offset(0) Set Rng2 = TPE.Range("L1") Set Rng2 = Rng2.Offset(0) Set Rng3 = TPE.Range("N1") Set Rng3 = Rng3.Offset(0)

24/06/2015, 14h09
eric4459
Bonjour Admdg,

Citation:

Petite question, "RSLT" que tu utilises pour déclarer la feuille 1, c'est juste des lettres que tu as mis histoire de déclarer la feuille ? Parce que je ne te vois pas le remettre par la suite.

En effet j'ai nommé la feuille RSLT diminutif de "résultat".
Si tu ne le vois plus apparaitre ensuite c'est que j'ai également déclaré:
Code:

1 2 Set RSLT = ThisWorkbook.Sheets("Feuil1") Set Rng1 = RSLT.Range("A1")
J'utilise dans la suite du code Rng1 mais plus RSLT, c'est une habitude que j'ai prise pour déclarer mes variables.
J'aurai pu déclarer de cette façon:

Code:

Set Rng1 =ThisWorkbook.Sheets("Feuil1").Range("A1")

Cette dernière variante est plus "économe" en écriture mais pour chasser les mauvaises habitudes cela prend un peu de temps :? ;)
Voir la remarque de Joe plus haut pour:

Code:

Set Rng1 = Rng1.Offset(0)

dont je pourrais me passer également :roll:
Eric
24/06/2015, 14h31
admdg

Ah j'avais un doute mais c'était bien ça ;)

Mais du coup je ne comprends toujours pas pourquoi est-ce que ça ne fonctionne pas sur mon fichier d'origine ( le lien avec le fichier mis à jour : https://mon-partage.fr/f/OrmlvH7e/ ), lorsque je lance la macro j'ai juste le contenu de la feuille 2 qui disparait et aucun résultat dans la colonne souhaitée en feuille 1 :zen:
24/06/2015, 14h56
eric4459

admdg,
En fait c'est normal que tu effaces tout :calim2:
Voici la ligne en cause:

Code:

TPE.Range("$a$1:$o$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3) 'on enlève les doublons

Et voici l'explication:
Tu déclare ta zone depuis la colonne A jusqu'à la colonne O et pour toutes les lignes comptées précédement

Code:

Range("$a$1:$o$" & NbLigne

Ensuite tu précises, mais cela tu devais l'ignorer, qu'il faut enlever les doublons dans les colonnes 1 et 3 de la selection

Code:

RemoveDuplicates Columns:=Array(1, 3)

Or dans tes colonnes 1 et 3 de la sélection (colonnes A et C en fait), tu n'as que des "x" :bug:
Donc la suppression des doublons se fait sur ces valeurs, qui sont identiques sur chaque ligne :ptdr:
Tu devrais plutot écrire:

Code:

TPE.Range("$A$1:$O$" & NbLigne).RemoveDuplicates Columns:=Array(12, 14)

ou

Code:

TPE.Range("$L$1:$N$" & NbLigne).RemoveDuplicates Columns:=Array(1, 3)

Eric

Bon,
Il y a encore des bugs, enlèves Rng3(k,2) et remplaces par Rng2(i,2).
Ensuite vérifie en pas à pas (Sélectionnes les variables qui t'interessent, Rng2(i,2) par exemple, et après un clic droit sélectionnes "Ajouter un espion", tu devrais voir une fenetre apparaitre et tu verras toutes les valeurs que prend ta ou tes variables sélectionnées puis mets toi sur la première ligne de ton code et cliques sur F8 pour passer chacune des lignes)
Eric

Eric,
Je suis finalement arrivé à transposer le code sur mon fichier grâce à tes conseils, cependant je rencontre encore un problème avec une Erreur d'exécution 13 Incompatibilité de type qui apparaît en me surlignant la ligne

Code:

Rng1.Offset(j, 6) = Rng1.Offset(j, 6) + 1

Ce que je ne comprends pas parce que j'ai seulement changé TPE en LVC et BIS en NOR... :weird:

Je te mets l'ensemble de mon code ici :

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
58
59
60
Sub methodesansemplacements()
Dim i As Integer
Dim j As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Dim LVC As Worksheet
Dim RSLT As Worksheet
Dim NbLigne As Integer
Set RSLT = ThisWorkbook.Sheets("Feuil1")
Set LVC = ThisWorkbook.Sheets("Feuil2")
Set Rng1 = RSLT.Range("A2")
Set Rng1 = Rng1.Offset(0)
Set Rng2 = LVC.Range("L1")
Set Rng2 = Rng2.Offset(0)
 
'Correction des cases qui sautent avec le code suivant
    Range("G2:G26").Select
    Range("G2:G26,G28:G53").Select
    Range("G28").Activate
    Selection.ClearContents
     Range("K3").Select
'correction code suivant
Range("G1").Select
    Selection.Copy
    Range("G28").Select
    ActiveSheet.Paste
    Range("N27").Select
       Range("A70:B73").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G70:G73").Select
    ActiveSheet.Paste
 
 
 
With LVC
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet
 
End With
 
 LVC.Range("$A$1:$O$" & NbLigne).RemoveDuplicates Columns:=Array(12, 14)
 
With LVC
 
      NbLigne = .Cells(.Rows.Count, 11).End(xlUp).Row   ' On compte le nombre de lignes de l'onglet après suppression des doublons
 
End With
 
For i = 0 To NbLigne
If (Rng2.Offset(i, 0) Like "*LVC*" Or Rng2.Offset(i, 0) Like "*RE1*") And (Rng2.Offset(i, 2) Like "*NOR*" Or Rng2.Offset(i, 0) Like "*CA*") Then ' on recherche les lignes qui contiennent RE1 ou LVC ayant un code NOR ou CA
            For j = 0 To NbLigne
                If Rng2.Offset(i, -7) >= Rng1.Offset(j, 1) And Rng2.Offset(i, -7) <= Rng1.Offset(j, 2) Then 'Quand la ligne est trouvée on vérifie que la date correspondante ( Rng2.Offset(1, -2) ) est comprise dans
                Rng1.Offset(j, 6) = Rng1.Offset(j, 6) + 1                                                'la période définie par les colonnes B et C de la feuille 1
                End If                                                                                    ' et on ajoute 1 au compteur colonne D feuille 1
            Next j
        End If
Next i
 
End Sub

Peut-être un problème de variable non ?

Salut Admdg,
Peux-tu envoyer le fichier stp?
Sinon que cherches-tu à faire avec ceci ? :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'Correction des cases qui sautent avec le code suivant
    Range("G2:G26").Select
    Range("G2:G26,G28:G53").Select
    Range("G28").Activate
    Selection.ClearContents
     Range("K3").Select
'correction code suivant
Range("G1").Select
    Selection.Copy
    Range("G28").Select
    ActiveSheet.Paste
    Range("N27").Select
       Range("A70:B73").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G70:G73").Select
    ActiveSheet.Paste

Eric

25/06/2015, 15h04
admdg

Oui ce sera plus clair en effet

https://mon-partage.fr/f/VIJbwnsp/

je t'ai créé une copie de mon fichier d'origine dans laquelle j'ai juste supprimé deux onglets et épuré le contenu de la feuil2 où se trouve ma liste de données,

Pour le code que tu as cité je viens de réalisé que c'était un peu bête d'avoir enregistré une macro pour ça... enfaite tu vas voir en ouvrant mon fichier mais j'ai deux cellules où figure du texte et vu que le code sur lequel on a travaillé s'étant sur toute la colonne ça écrase les deux cellules, du coup j'ai fais un copié collé mais j'aurais dû me la jouer autrement

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