Discussion :

[admdg]

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

[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

[admdg]

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[eric4459]

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



et tu va voir c'est magique !!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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/

[eric4459]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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é

Classeur1 v2 Eric.xlsm

Eric

[eric4459]

Attention,
L'un des deux fichiers fourni n'est pas correct.. boulette
Voici le bon
Classeur1 v2 Eric.xlsm

Eric

[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

[eric4459]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[admdg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[eric4459]

Bonjour Admdg
Voici le code avec balise:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

au lieu de cela tu devrais écrire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[joe.levrai]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[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

[admdg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

[eric4459]

Bonjour Admdg,

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Rng1 = Rng1.Offset(0)

dont je pourrais me passer également
Eric

[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

[eric4459]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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"
Donc la suppression des doublons se fait sur ces valeurs, qui sont identiques sur chaque ligne
Tu devrais plutot écrire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

ou

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[admdg]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

Je te mets l'ensemble de mon code ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

[eric4459]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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