fonction personalisée decompte valeur tableau mémoire

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Hoareau

XLDnaute Occasionnel
Bonjour

J'ai crée un tableau dynamique et une fonction pour décompter les valeurs dans le tableau.

Quand la procedure fait appel à une reference fixe sur la page excel, celma fonctionne

si je fait appel au tableau en mémoire cela me donne des chiffres faux


merci

Public My_Array_Tab_Dynamic() As Variant

Sub tab_Dynamique_ligne()
Application.ScreenUpdating = False

For lig = 6 To 9
For col = 5 To 9


Set mondico = CreateObject("scripting.dictionary")

i = i + 1

ReDim Preserve My_Array_Tab_Dynamic(1 To i)

Set R = Range(Cells(lig, col), Cells(lig, col))


For Each c In R

If Not mondico.exists(c.Value) Then mondico.Add i, c.Value

My_Array_Tab_Dynamic(i) = mondico.Items


Cells(lig, col + 10) = mondico.Items
Cells(lig, col + 20) = mondico.Keys


Cells(lig, 39).Resize(, i) = Application.Transpose(My_Array_Tab_Dynamic)
Next c

Cells(lig, 35) = LBound(My_Array_Tab_Dynamic)
Cells(lig, 36) = UBound(My_Array_Tab_Dynamic)

Next
Next
Application.ScreenUpdating = True
End Sub

"""""""""""""""""""""""""""""""""""""""""""""""
Sub Compte_Valeur_Tableau()
'On Error Resume Next


Dim stat(2, 20)

For i = LBound(stat, 1) To UBound(stat, 1)
For j = LBound(stat, 2) To UBound(stat, 2)

stat(0, j) = j
stat(1, j) = CompteVal(My_Array_Tab_Dynamic, j)

[O15].Resize(2, 20) = stat

Next

Next

End Sub

"""""""""""""""""""""""""""""""""""""""""""""""

Function CompteVal(Plage() As Variant, ByVal T_1 As Integer) As Long

'On Error Resume Next
CompteVal = 0

For a = LBound(Plage, 1) To UBound(Plage, 1)
For b = LBound(Plage, 2) To UBound(Plage, 2)

If Plage(a, b) = T_1 Then CompteVal = CompteVal + 1


Next
Next

End Function
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
236
Réponses
4
Affichages
177
Réponses
8
Affichages
466
Réponses
3
Affichages
665
Réponses
6
Affichages
86
Réponses
10
Affichages
281
Retour