Utilisation de Maplage

[erics83]

Bonjour,

J'ai un classeur avec une feuille très chargée (~100000 lignes), sur laquelle je dois faire des requêtes.

Pour l'instant j'ai tout plein de tableaux qui analysent les données, via des SOMMEPROD, mais c'est trop long (j'ai mis un exemple dans le classeur).

J'ai essayé aussi la solution

For i =

qui prend beaucoup de temps....d'où mon option d'essayer

Dim maplage As Range
Dim DerligR1 As Long


With Worksheets("Feuil1")
    DerligR1 = .Range("a" & .Rows.Count).End(xlUp).Row
     Set maplage = .Range(.Cells(1, 1), .Cells(DerligR1, 61))
End With

Mais je ne sais pas comment faire pour mes requêtes..... :

Par exemple, (dans mon classeur exemple) , compter le nombre (=colonne D) pour le mois de Janvier 2015 pour Eric1, avec la condition "OUI",

Mais je ne sais pas comment l'écrire.....

Une petite aide ?

En vous remerciant,

 

[KIM]

Re : Utilisation de Maplage

Re le fil,
Merci Efgé, cela fonctionne bien.
Je vais essayer de l'adapter à mon tableau.
Par contre, je n'ai pas de critere = [I6] & [I5] & "OUI", mon récap est par année et par nom (Année ; nom; somme; nbre).

Comment l'adapter sur le même exemple ?


PS: Les messages se sont croisés, merci Job75, je regarde.

Merci d'avance.
KIM

 

[gosselien]

Re : Utilisation de Maplage

Bonjour,

ça , c'est quand on envoie un fichier exemple différent du fichier originel...c'est pourtant pas dur de faire une copie anonymisée du fichier de base pour poser sa question ...

P.

 

[job75]

Re : Utilisation de Maplage

Re, salut gosselien,

Ah oui, vous voulez compter seulement les t(i, 4) > 0 donc l'ajouter dans le test :

Sub Comptage()
Dim dest As Range, critere$, t, d As Object, dc As Object, i&, a, b, c
Set dest = [H8] 'à adapter
critere = [I6] & [I5] & "OUI" 'à adapter
t = [A1].CurrentRegion.Resize(, 5) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set dc = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If t(i, 1) <> "" And t(i, 4) > 0 And t(i, 2) & t(i, 3) & UCase(t(i, 5)) = critere _
    Then d(t(i, 1)) = d(t(i, 1)) + t(i, 4): dc(t(i, 1)) = dc(t(i, 1)) + 1
Next
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, 3).ClearContents 'RAZ
If d.Count Then
  a = d.keys: b = d.items: c = dc.items
  ReDim t(UBound(a), 2) 'base 0
  '---transposition---
  For i = 0 To UBound(a)
    t(i, 0) = a(i): t(i, 1) = b(i): t(i, 2) = c(i)
  Next
  '---restitution---
  dest.Resize(d.Count, 3) = t
  dest.Resize(d.Count, 3).Sort dest, xlAscending, Header:=xlNo 'tri
End If
End Sub

A+

 

[Efgé]

Re : Utilisation de Maplage

Re à tous, Bonjour gosselin



@ KIM
Comme indiqué par gosselin, sans un exemple réel de la structure de base, il va être difficile d'y aller à taton.....


A te relire avec un fichier.
Cordialement

 

[KIM]

Re : Utilisation de Maplage

Re le fil & le forum,

@Job75, en testant j'ai remarqué que le script ne prend pas en compte les données de la col D > 0.
Merci pour le nouveau script. je teste.

@Gosselien,
En effet j'ai envoyé un fichier dans mon post #13. Je croyais que les explications du post #16 étaient suffisantes. Désolé. Je vous transmet un nouveau fichier avec le résultat souhaité.

Merci encore
KIM

 

[job75]

Re : Utilisation de Maplage

Message annulé.

 

[Efgé]

Re : Utilisation de Maplage

Re
Ma version mise à jour:

Option Explicit
Sub Test_Efge_4()
Dim dest As Range, t As Variant, d As Object, i&, Ky$, Nb&
   
Set dest = [G8] 'à adapter
t = Range(Cells(2, 1), Cells(Rows.Count, 1).End(3)(1, 5))
Set d = CreateObject("Scripting.Dictionary")


For i = 1 To UBound(t)
    Ky = Trim(t(i, 3)) & Trim(t(i, 1))
    Nb = t(i, 4)
    If Not d.exists(Ky) Then
        d(Ky) = d.Count + 1
        t(d(Ky), 2) = t(i, 1)
        t(d(Ky), 1) = t(i, 3)
        t(d(Ky), 3) = 0
        t(d(Ky), 4) = 0
    End If
    t(d(Ky), 3) = t(d(Ky), 3) + Nb
    If Nb > 0 Then t(d(Ky), 4) = t(d(Ky), 4) + 1
Next i


Application.ScreenUpdating = False
dest.Resize(UBound(t, 1), 4).ClearContents
If d.Count Then
      With dest.Resize(d.Count, 4)
          .Value = t
          .Sort dest, xlAscending, Header:=xlNo 'tri
    End With
End If
Application.ScreenUpdating = True
End Sub

Cordialement

 

[job75]

Re : Utilisation de Maplage

Re,

Avec 4 Dictionary :

Sub Comptage()
Dim dest As Range, t, d1 As Object, d2 As Object, d3 As Object
Dim d4 As Object, i&, x$, a, b, c, d
Set dest = [G8] 'à adapter
t = [A1].CurrentRegion.Resize(, 5) 'matrice, plus rapide
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Set d4 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If t(i, 1) <> "" And t(i, 4) <> 0 Then 'And UCase(t(i, 5)) = "OUI" ?
    x = LCase(t(i, 1)) & t(i, 3) 'nom + année
    d1(x) = t(i, 3): d2(x) = t(i, 1)
    d3(x) = d3(x) + t(i, 4): d4(x) = d4(x) + 1
   End If
Next
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, 4).ClearContents 'RAZ
If d1.Count Then
  a = d1.items: b = d2.items: c = d3.items: d = d4.items
  ReDim t(UBound(a), 3) 'base 0
  '---transposition---
  For i = 0 To UBound(a)
    t(i, 0) = a(i): t(i, 1) = b(i): t(i, 2) = c(i): t(i, 3) = d(i)
  Next
  '---restitution---
  dest.Resize(d1.Count, 4) = t
  dest.Resize(d1.Count, 4).Sort dest, xlAscending, dest(1, 2), , xlAscending, Header:=xlNo 'tri
End If
End Sub

Si l'on veut ne pas compter les valeurs négatives, remplacer t(i, 4) <> 0 par t(i, 4) > 0

A+

 

[KIM]

Re : Utilisation de Maplage

Re le fil, Job75, Efgé

Merci pour votre contribution. Vos derniers scripts donnent les résultats souhaités.
@Job75, Résultat attendu OK, j'ai même intégré le test [ And UCase(t(i, 5)) = "OUI" ]
@ Efgé,
Le résultat du script est trié pour 2015 seulement et non pour 2016.
Est-ce que la dernière col E est prise en compte dans les tableaux dynamiques ? et si oui où Est-ce je peux intégrer
le test [ And UCase(t(i, 5)) = "OUI" ] ?

Merci encore à vous deux, merci le fil et le forum.
KIM

 

[Efgé]

Re : Utilisation de Maplage

Re

... Par contre, je n'ai pas de critere = [I6] & [I5] & "OUI", mon récap est par année et par nom (Année ; nom; somme; nbre).

...si oui où Est-ce je peux intégrer le test [ And UCase(t(i, 5)) = "OUI" ]

Tu peux te mettre d'accord avec toi-même?
Cordialement

 

[job75]

Re : Utilisation de Maplage

Re,

4 Dictionary c'est quand même lourding... Alors un seul comme Efgé :

Sub Comptage()
Dim dest As Range, t, d As Object, i&, x$, n&
Set dest = [G8] 'à adapter
t = [A1].CurrentRegion.Resize(, 5) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  If t(i, 1) <> "" And t(i, 4) <> 0 Then 'And UCase(t(i, 5)) = "OUI" ?
    x = LCase(t(i, 1)) & t(i, 3) 'nom + année
    If Not d.exists(x) Then
      d(x) = d.Count + 1 'mémorisation de la ligne
      n = d(x)
      t(n, 1) = t(i, 3): t(n, 2) = t(i, 1): t(n, 3) = 0: t(n, 4) = 0
    End If
    n = d(x)
    t(n, 3) = t(n, 3) + t(i, 4): t(n, 4) = t(n, 4) + 1
   End If
Next
'---restitution---
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, 4).ClearContents 'RAZ
If d.Count Then
  dest.Resize(d.Count, 4) = t
  dest.Resize(d.Count, 4).Sort dest, xlAscending, dest(1, 2), , xlAscending, Header:=xlNo 'tri
End If
End Sub

Les résultats sont les mêmes sauf un, Efgé aurait dû écrire If Nb <> 0 au lieu de If Nb > 0...

A+

 

[KIM]

Re : Utilisation de Maplage

Re le fil, le forum,
Merci encore,
@Job75, en effet j'ai testé le script de Efgé avec If Nb <> 0 au lieu de If Nb > 0 ce qui m'a donné les mêmes résulté que le tien.
@Efgé, Dans le script de Job75 il y avait encore la possibilité de rajouter ce test. C'était une curiosité de ma part pour savoir si j'ai bien lu ton code et je n'ai pas trouvé la possibilité de l'ntégrer.

Bonne fin de journée et merci pour votre contribution
KIM

 

[Efgé]

Re : Utilisation de Maplage

Re
C'est ici que ça se passe:

For i = 1 To UBound(t)
    If UCase(t(i, 5)) = "OUI" Then ' condition
        Ky = Trim(t(i, 3)) & Trim(t(i, 1))
        Nb = t(i, 4)
        If Not d.exists(Ky) Then
            d(Ky) = d.Count + 1
            t(d(Ky), 2) = t(i, 1)
            t(d(Ky), 1) = t(i, 3)
            t(d(Ky), 3) = 0
            t(d(Ky), 4) = 0
        End If
        t(d(Ky), 3) = t(d(Ky), 3) + Nb
        If Nb <> 0 Then t(d(Ky), 4) = t(d(Ky), 4) + 1
     End If' Fin de condition
Next i

Cordialement

 

[KIM]

Re : Utilisation de Maplage

Merci Efgé pour ta patience. J'ai bien noté la modif.

Bonne fin de journée à vous tous
KIM

 

[KIM]

Re : Utilisation de Maplage

Bonjour le fil, le forum, Bonjour Job75 & Efgé,
Merci pour ces 2 macros. Exécution correcte et rapide sur un fichier de plusieurs centaine de lignes. Je reviens vers vous pour la présentation du résultat. Est-il possible d'avoir, comme résultat, dans une autre feuille du classeur, les noms comme titre de colonne et en ligne l'année, la somme et le nombre par année. voir fichier joint

Par avance merci de votre aide
KIM