Discussion :

[stueur666]

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]

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]

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]

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]

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]

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