Ligne de code countif ne fonctionne pas systématiquement

**stueur666** · 15/11/2018, 10h14

Bonjour,

Je suis en cours de rédaction d'un code pour :
1) Regarder dans la table 1 la quantité de ligne correspondant à un critère
2) Si la quantité de ligne est supérieure à 2, regarder si mon critère est dans la table 2
3) Si le critère n'est pas déjà présent dans la table 2, copier le critère dans la table 2

Pour cela j'ai créer le code ci-dessous

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
 
Sub mise_a_jour()
 
Dim i As Integer
Dim MaxDantotsu As Integer
Dim k As Integer
Dim j As Integer
 
Dim Dantotsu As Worksheet
Dim Data_CVI As Worksheet
 
Set Dantotsu = Sheets("Dantotsu")
Set Data_CVI = Sheets("Data_CVI")
 
Data_CVI.Activate
 
'Déterminer le numéro Dantotsu max de l'onglet Data_CVI
    MaxDantotsu = Data_CVI.Application.WorksheetFunction.Max(Range("g2:g" & Range("g65530").End(xlUp).Row))
 
'Copier les numéros Dantotsu dans l'ordre croissant et sans saut de ligne depuis l'onglet Data_CVI vers l'onglet Dantotsu. Les nouveaux points Dantotsu s'affichent sur fond rouge
    k = 2
    For i = 1 To MaxDantotsu
        If Data_CVI.Application.WorksheetFunction.CountIf([g:g], UCase(i)) > 2 Then
'            If Dantotsu.Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(MaxDantotsu, 1)), i) = 0 Then
'            j = Dantotsu.Application.WorksheetFunction.CountIf([A:A], UCase(i))
            Dantotsu.Cells(1, 7).Value = Application.WorksheetFunction.CountIf(Range("A2:A" & MaxDantotsu), i)
            If j = 0 Then
'            If Dantotsu.Application.WorksheetFunction.CountIf([A:A], UCase(i)) = 0 Then
                Dantotsu.Cells(k, 1) = i
                Dantotsu.Cells(k, 1).Interior.ColorIndex = 3
            End If
            k = k + 1
        End If
    Next i
 
End Sub

Comme visible ci-dessus j'ai essayé plusieurs façon de vérifier que mon critère "i" soit présent dans la table 2 (Dantotsu) mais cela ne fonctionne pas...

Si quelqu'un avait la gentillesse de m'éclairer, je lui en serais reconnaisssant.

Cordialement
Sylvain

**MarcelG** · 15/11/2018, 12h33

Bonjour stueur,

2 remarques
i étant numérique,

Code :

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

Ucase(i)

ne sert à rien. "i" sufit
Considérer le maximum de ta colonne initiale G de la feuille Data_CVI suppose que les données soient suivies (1,2,3...65).
Dans le cas contraire (1,2,3,23,34,....45,65), il faudrait plutôt balayer ta plage d'origine et créer un dictionnaire dont les clés seraient décomptés.
Ces données sont-elles suivies?

**MarcelG** · 15/11/2018, 13h49

Salut,

Code effectif pour tous les cas de figure.
Attention! Vérifier l'adressage (A2, ...)

Pense à activer la Référence Scripting.Runtime (Menu Outils\Références de ton éditeur VBE)
Ceci afin de bien déclarer le dictionnaire, trop généralement déclaré en Variant.
Ce type de déclaration permet d'obtenir toutes les propriétés et méthodes lors de la saisie.

Tu peux tester par une exécution pas à pas. (éventuellement point d'arrêt)

Reviens pour toute question.

Voici, Voilou

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
61
62
63
64
65
66
Option Explicit
 
Sub marcel_mise_a_jour()
 
Dim Dantotsu As Worksheet
Dim Data_CVI As Worksheet
 
Set Dantotsu = ThisWorkbook.Worksheets("Dantotsu")
Set Data_CVI = ThisWorkbook.Worksheets("Data_CVI")
 
Dim i As Integer, j As Integer, k As Integer
 
Dim derlignsu As Integer, derligncvi As Integer
Dim laplagesu As Range, laplagecvi As Range
 
Dim c As Range
 
'---------------------------------------------------------------
'Activer la Référence Scripting.Runtime
''---------------------------------------------------------------
Dim dico As Scripting.Dictionary
 
Dim clé As Variant
Dim t As Range
 
With Dantotsu
    derlignsu = .Cells(.Rows.Count, 7).End(xlUp).Row
    Set laplagesu = .Range("A1:A" & derlignsu)
End With
 
With Data_CVI
        derligncvi = .Cells(.Rows.Count, 7).End(xlUp).Row
        Set laplagecvi = .Range("G2:G" & derligncvi)
End With
 
Set dico = CreateObject("Scripting.Dictionary")
 
For Each c In laplagecvi
        With c
                If Not dico.Exists(c.Value) Then _
                            dico.Add .Value, .Value
        End With
Next c
 
For Each clé In dico.Keys
        If Application.WorksheetFunction.CountIf(laplagecvi, clé) > 2 Then
                Set t = laplagesu.Find(clé, LookIn:=xlValues, Lookat:=xlWhole)
                If t Is Nothing Then
                        Dantotsu.Cells(derlignsu + 1, 1).Value = clé
                        derlignsu = derlignsu + 1
                        Set laplagesu = Dantotsu.Range("A1:A" & derlignsu)
                End If
                Set t = Nothing
        End If
Next clé
 
dico.RemoveAll
Set dico = Nothing
 
Set laplagecvi = Nothing
Set laplagesu = Nothing
 
Set Data_CVI = Nothing
Set Dantotsu = Nothing
 
End Sub

**stueur666** · 16/11/2018, 10h31

Bonjour MarcelG et merci beaucoup!

Je viens de tester et cela fonctionne parfaitement. Je vais avoir besoin de mettre dans l'odre croissant les numéros et de ne pas afficher de cellule vide mais j'espère pouvoir m'en sortir seul.
Je note le sujet comme résolu.
Bonne journée

Sylvain

**stueur666** · 16/11/2018, 12h11

Il me vient une question : si je veux que seules les données supérieures à 2 exemplaires ne soient dans le dictionnaire, quelles modifications dois-je apporter?
En d'autres termes : je souhaiterais faire le calcul des données supérieures à 2 exemplaires avant dans le processus pour ne plus avoir à manipuler que ces données.

Merci d'avance et bonne journée

**MarcelG** · 16/11/2018, 12h28

Salut,

Si j'ai bien compris, le dictionnaire est enrichi par les seules données décomptées plus de 2 fois.
Il suffit de déplacer cette condition vers l'alimentation du dictionnaire.

Comme suit

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
61
62
63
64
Sub marcel_mise_a_jour_2()
 
Dim Dantotsu As Worksheet
Dim Data_CVI As Worksheet
 
Set Dantotsu = ThisWorkbook.Worksheets("Dantotsu")
Set Data_CVI = ThisWorkbook.Worksheets("Data_CVI")
 
Dim i As Integer, j As Integer, k As Integer
 
Dim derlignsu As Integer, derligncvi As Integer
Dim laplagesu As Range, laplagecvi As Range
 
Dim c As Range
 
'---------------------------------------------------------------
'Activer la Référence Scripting.Runtime
''---------------------------------------------------------------
Dim dico As Scripting.Dictionary
 
Dim clé As Variant
Dim t As Range
 
With Dantotsu
    derlignsu = .Cells(.Rows.Count, 7).End(xlUp).Row
    Set laplagesu = .Range("A1:A" & derlignsu)
End With
 
With Data_CVI
        derligncvi = .Cells(.Rows.Count, 7).End(xlUp).Row
        Set laplagecvi = .Range("G2:G" & derligncvi)
End With
 
Set dico = CreateObject("Scripting.Dictionary")
 
For Each c In laplagecvi
        With c
                If Application.WorksheetFunction.CountIf(laplagecvi, .Value) > 2 Then
                        If Not dico.Exists(c.Value) Then _
                                    dico.Add .Value, .Value
                End If
        End With
Next c
 
For Each clé In dico.Keys
        Set t = laplagesu.Find(clé, LookIn:=xlValues, Lookat:=xlWhole)
        If t Is Nothing Then
                Dantotsu.Cells(derlignsu + 1, 1).Value = clé
                derlignsu = derlignsu + 1
                Set laplagesu = Dantotsu.Range("A1:A" & derlignsu)
        End If
        Set t = Nothing
Next clé
 
dico.RemoveAll
Set dico = Nothing
 
Set laplagecvi = Nothing
Set laplagesu = Nothing
 
Set Data_CVI = Nothing
Set Dantotsu = Nothing
 
End Sub

**stueur666** · 16/11/2018, 14h41

Encore une fois, un grand merci! Ca fonctionne parfaitement!

Du coup, je souhaite que la macro vérifie si la présence de la données du dictionnaire est présente dans la colonne A de la feuille Dantotsu et ne colle la donnée que si elle n'était pas déjà présente.

Code :

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

1
2
3
4
5
6
7
8
9
10
 
For Each clé In dico.Keys
        Set t = laplagesu.Find(clé, LookIn:=xlValues, Lookat:=xlWhole)
            If t Is Nothing Then
                Dantotsu.Cells(derlignsu + 1, 1).Value = clé
                derlignsu = derlignsu + 1
                Set laplagesu = Dantotsu.Range("A1:A" & derlignsu)
            End If
        Set t = Nothing
Next clé

Sur le passage ci-dessus, je pensais que le "If t Is Nothing" vérifiait la présence de t dans la colonne A de la feuille Dantotsu mais cela n'a pas l'air d'être le cas car j'ai essayé de relancer la macro en ayant déjà des données dans la colonne A de la feuille Dantotsu mais, après l'utilisation de la macro, toutes les données ont été écrasées.
J'ai aussi essayé d'ajouter quelque chose du type :

Code :

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

1
2
 
if application.worksheetfunction.countif(laplagesu, t) is nothing then

Mais je reçois un message d'erreur concernant une incompatbilité de type avec le countif.

Merci d'avance et bonne journée

**MarcelG** · 16/11/2018, 15h15

Salut,

Ouh là!

Code :

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

if application.worksheetfunction.countif(laplagesu, t) is nothing then

La valeur Nothing, généralement, ne s'affecte qu'à un objet déclaré par Set....
De plus, CountIf est une donnée numérique statistique.

Oui, la présence de la variable t est bien testée.

C'était une question d'adressage.
Sauf erreur, je t'avais indiqué la nécessité de le vérifier.

J'ai modifié mon code.
La plage testée est en 7ème colonne (G) de la feuille Data_CVI.
Les résultats sont reportés en 1ère colonne (A) de la feuille Dantotsu.
Je te conseille d'exécuter le code pas à pas, à partir d'un point d'arrêt placé après l'alimentation du dictionnaire.
Et surtout de le comprendre.

Code modifié.Tu regardes pour savoir à quel endroit.
Tu reviens pour toute question.

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
61
62
63
64
Sub marcel_mise_a_jour_2()
 
Dim Dantotsu As Worksheet
Dim Data_CVI As Worksheet
 
Set Dantotsu = ThisWorkbook.Worksheets("Dantotsu")
Set Data_CVI = ThisWorkbook.Worksheets("Data_CVI")
 
Dim i As Integer, j As Integer, k As Integer
 
Dim derlignsu As Integer, derligncvi As Integer
Dim laplagesu As Range, laplagecvi As Range
 
Dim c As Range
 
'---------------------------------------------------------------
'Activer la Référence Scripting.Runtime
''---------------------------------------------------------------
Dim dico As Scripting.Dictionary
 
Dim clé As Variant
Dim t As Range
 
With Dantotsu
    derlignsu = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set laplagesu = .Range("A1:A" & derlignsu)
End With
 
With Data_CVI
        derligncvi = .Cells(.Rows.Count, 7).End(xlUp).Row
        Set laplagecvi = .Range("G2:G" & derligncvi)
End With
 
Set dico = CreateObject("Scripting.Dictionary")
 
For Each c In laplagecvi
        With c
                If Application.WorksheetFunction.CountIf(laplagecvi, .Value) > 2 Then
                        If Not dico.Exists(c.Value) Then _
                                    dico.Add .Value, .Value
                End If
        End With
Next c
 
For Each clé In dico.Keys
        Set t = laplagesu.Find(clé, LookIn:=xlValues, Lookat:=xlWhole)
        If t Is Nothing Then
                Dantotsu.Cells(derlignsu + 1, 1).Value = clé
                derlignsu = derlignsu + 1
                Set laplagesu = Dantotsu.Range("A1:A" & derlignsu)
        End If
        Set t = Nothing
Next clé
 
dico.RemoveAll
Set dico = Nothing
 
Set laplagecvi = Nothing
Set laplagesu = Nothing
 
Set Data_CVI = Nothing
Set Dantotsu = Nothing
 
End Sub

**stueur666** · 16/11/2018, 16h26

Je crois que j'ai manqué un truc.
Le code de votre dernier message et de celui 12h28 sont strictement identiques.
Je fais le pas-à-pas systématiquement mais certaines fonctions n'étant pas "visibles" via des espions, je ne comprends pas tout le fonctionnement du code.
Dans tous les cas, merci pour votre aide.

**MarcelG** · 19/11/2018, 10h30

Bonjour à toi, Bonjour au Forum,

Quelle partie de code ne comprends-tu pas?
Plutôt que des variables espions, certes parfois utiles, je te conseillerais d'afficher la fenêtre des variables locales et de voir son évolution lors de l'exécution pas à pas.
Le code est effectif sur mon poste.
Reviens donc en précisant ta problématique (ce que tu attends, ce que ne fait pas le code, à quel endroit...)
En dernier ressort, joins un classeur simplifié.

Ligne de code countif ne fonctionne pas systématiquement [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager