Discussion :

[gaston64]

Bonjour

A partir de 2 colonnes l'une contenant des "noms" et la deuxieme des "dates" ou des cellules vides, je souhaite construire un tableau avec:
-Dans la premiere colonnes: la liste de "noms" (avec suppression des doublons)
-Dans la deuxieme colonnes: le nombre de fois que que le noms est apparu dans la colonnes "source"
-Dans la troisième colonnes: le nombre de fois que le "nom" est apparu sans date en vis-à-vis
les lignes ne sont à prendre en compte que si elles sont visibles.

Je souhaite parvenir à ce résultat en utilisant les tableau de variables. Malheureusement mes connaissances en la matière sont faibles (j'ai lu le tutoriel). Je serai ravi si quelqu'un pouvait partager la solution à mon problème en y ajoutant quelque commentaires explicatifs.

Merci par avance.

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
Sub camembert()
 
Dim k As Variant
Dim f0 As Worksheet
Dim f1 As Worksheet
Dim f2 As Worksheet
Dim mondico3 As Object
Dim plage As Range
 
Set mondico3 = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("debut")
Set f1 = Sheets("temp")
 
    Dim Tabl4()
    ReDim Preserve Tabl4(1 To plage.Rows.Count, 1)
 
With f0
 
i = 9
        For Each Cell In .Range("T10", .Range("T" & Rows.Count).End(xlUp))
        i = i + 1
        If f0.Cells(i, 10).EntireRow.Hidden = False Then
           mondico3(c.Value) = c.Value
        End If
        Next c
   Tabl4 = mondico3.keys
End With
 
f1.Range("A40").Resize(UBound(Tabl4, 1), UBound(Tabl4, 1)) = Application.Transpose(rng1)
 
End Sub

[pijaku]

Bonjour,

J'ai surtout l'impression que tu te mélanges un peu dans tout cela non?

Nous allons donc procéder point par point, si tu le veux bien.
Préalablement :
Dans ton code je vois :

Code :

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

If f0.Cells(i, 10).EntireRow.Hidden = False Then

Tu as donc des lignes masquées? Comment? Quoi? Pourquoi?

Code :

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

1
2
f1.Range("A40").Resize(UBound(Tabl4, 1), UBound(Tabl4, 1)) = Application.Transpose(rng1)
End Sub

C'est quoi rng1???

Prenons donc, dans l'ordre ta première question :
1- Dans la premiere colonne: la liste de "noms" (avec suppression des doublons)

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
Dim f0 As Worksheet
Dim f1 As Worksheet
Dim Cel As Range
Dim mondico3 As Object
Set mondico3 = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("debut")
Set f1 = Sheets("temp")
'On remplit le dictionnaire, sans doublons
With f0
    For Each Cel In .Range("T10", .Range("T" & Rows.Count).End(xlUp))
        mondico3(Cel.Value) = ""
    Next Cel
End With
'Restitution en utilisant Resize et Transpose (de la même manière que toi...)
f1.Range("A40").Resize(mondico3.Count, 1) = Application.Transpose(mondico3.keys)
Set mondico3 = Nothing
Set f0 = Nothing
Set f1 = Nothing

Comme tu peux le constater, nul besoin de passer par une variable tableau intermédiaire. De plus, tu ne gagneras pas, en rapidité en passant par un tableau, l'objet Dictionnary est aussi rapide à l'exécution...

[casefayere]

Bonjour à tou(te)s,

proposition à adapter à tes cellules :

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 camembert()
'exemple données en A dans feuille "debut"
Dim i As Long, j
Dim f0 As Worksheet
Dim f1 As Worksheet
Dim Mondico As Object
Dim plage As Range, cel As Range
 
Set Mondico = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("debut")
Set f1 = Sheets("temp")
Mondico.RemoveAll: i = 0
With f0
  Set plage = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) 'ta plage de recherche
  For Each cel In plage
    If Not Mondico.exists(cel.Value) And cel.Value <> "" Then 'si la cle n'existe pas et la cellule n'est pas vide
      Mondico.Add cel.Value, cel.Value 'on ajoute le nom
    End If
  Next cel
End With
i = 2
For Each j In Mondico.items
  f1.Range("A" & i) = j 'copie en feuille "temp"
  f1.Range("B" & i) = WorksheetFunction.CountIf(plage, j) 'nbre de fois
  f1.Range("C" & i).FormulaR1C1 = _
        "=SUMPRODUCT(((debut!R2C1:R15C1)=temp!RC[-2])*((debut!R2C2:R15C2)=""""))" 'formule pour trouver date vide
  i = i + 1
Next j
'on tire la formule vers le bas
f1.Range("C2").AutoFill Destination:=f1.Range("C2:C" & Mondico.Count), Type:=xlFillDefault
'et on ne recolle que les valeurs
f1.Range("C2:C" & Mondico.Count).Copy
f1.Range("C2:C" & Mondico.Count).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
End Sub

[pijaku]

Ou alors, une variante à la proposition de casefayere, sans utiliser de formule de calcul, dans la "veine" de ce que j'avais commencé à expliquer. Les explications, en commentaires.

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
Option Explicit
 
Sub Gaston64()
'déclaration des variables
Dim f0 As Worksheet, f1 As Worksheet
Dim Cel As Range, MaPlage As Range
Dim Dico As Object, Tabl()
Dim i As Long
 
'affectation des objets aux variables
Set Dico = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("debut")
Set f1 = Sheets("temp")
i = 1
 
'Liste sans doublon + Nombre d'occurence + remplissage Tabl des données Col T & U
With f0
    'l'avantage de SpecialCells(xlCellTypeVisible) est d'éviter le test If .Hidden = False Then
    Set MaPlage = .Range("T10", .Range("T" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    For Each Cel In MaPlage                     '<== Boucle
        Dico(Cel.Value) = Dico(Cel.Value) + 1
        ReDim Preserve Tabl(1 To 2, 1 To i)     '<== redimensionnement et enregistrement de la variable tableau
        Tabl(1, i) = Cel.Value                  '<== remplissage tableau dimension 1
        Tabl(2, i) = Cel.Offset(, 1).Value      '<== remplissage tableau dimension 2
        i = i + 1
    Next Cel
End With
'Restitution de la liste sans doublons + Nbre d'occurences
f1.Range("A40").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
f1.Range("B40").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
'test si date
    'on voit ici l'intérêt d'avoir remplit notre variable tableau
    'dans la boucle ci-dessus
For i = LBound(Tabl, 2) To UBound(Tabl, 2)
    If IsDate(Tabl(2, i)) Then
        'si oui le nombre d'occurence = Nbre d'occurence total
        Dico(Tabl(1, i)) = Dico(Tabl(1, i))
    Else
        'si pas date ==> nombre d'occurence = Nbre d'occurence - 1
        Dico(Tabl(1, i)) = Dico(Tabl(1, i)) - 1
    End If
Next i
'restitution du nombre de dates par item de liste
f1.Range("C40").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
 
'vidage de la mémoire "effacement" des objets déclarés et affectés en début de procédure
Set Dico = Nothing
Set f0 = Nothing
Set f1 = Nothing
Set MaPlage = Nothing
End Sub

[gaston64]

Merci beaucoup pour vos réponses et les explications fournies. Dans mon cas j'ai voulu éviter de recopier des formules de calul. Je me suis donc orienté vers la dernière solution proposée.

Bonne journée