Utilisation de Maplage

erics83

XLDnaute Impliqué
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
Code:
For i =
qui prend beaucoup de temps....d'où mon option d'essayer
Code:
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,
 

Pièces jointes

  • Classeur1.xlsx
    62.9 KB · Affichages: 64
  • Classeur1.xlsx
    62.9 KB · Affichages: 51
Dernière édition:

job75

XLDnaute Barbatruc
Re : Utilisation de Maplage

Re,

Il "suffit" de traiter le 1er tableau en G8 mais c'est quand même laborieux :

Code:
Sub Traitement()
Dim source As Range, dest As Range, t, d1 As Object, d2 As Object
Dim d3 As Object, i&, ncol%, rest(), a, j%, an%, x$
Set source = [G8].CurrentRegion.Resize(, 4) 'à adapter
Set dest = [L8] 'à adapter
t = source
Set d1 = CreateObject("Scripting.Dictionary") 'année
Set d2 = CreateObject("Scripting.Dictionary") 'nom
Set d3 = CreateObject("Scripting.Dictionary") 'année+nom
d2.CompareMode = vbTextCompare 'la casse est ignorée
d3.CompareMode = vbTextCompare
'---dimensions du tableau rest---
For i = 1 To UBound(t) 'For i = 2 si ligne de titres
  d1(t(i, 1)) = ""
  d2(t(i, 2)) = ""
  d3(t(i, 1) & t(i, 2)) = i 'repérage de la ligne
Next
ncol = d2.Count + 1
ReDim rest(1 To 2 * d1.Count + 1, 1 To ncol)
'---remplissage des 1ère et 2ème colonnes du tableau rest---
a = d1.keys
For i = 2 To UBound(rest) Step 2
  rest(i, 1) = "Somme": rest(i, 2) = a(i / 2 - 1)
  rest(i + 1, 1) = "Nbre": rest(i + 1, 2) = rest(i, 2)
Next
'---remplissage de la 1ère ligne du tableau rest---
a = d2.keys
For j = 2 To ncol
  rest(1, j) = a(j - 2)
Next
'---reste du remplissage---
a = d3.items
For i = 2 To UBound(rest) Step 2
  an = rest(i, 2)
  For j = 3 To ncol
    x = an & rest(1, j)
    rest(i, j) = t(d3(x), 3)
    rest(i + 1, j) = t(d3(x), 4)
Next j, i
'---restitution---
Application.ScreenUpdating = True
dest.CurrentRegion.ClearContents 'RAZ
dest.Resize(UBound(rest), ncol) = rest
End Sub
A+
 
Dernière édition:

KIM

XLDnaute Accro
Re : Utilisation de Maplage

Re le fil, le forum,
@Job75,
Merci pour ton aide. Comme j'utilise au min les Dictionary, je ne pensais pas que c'est très compliqué de définir un format de sortie en colonnes et non en lignes quand le Dicyionary est déjà rempli. D'une manière générale, pour créer un tableau récapitulatif, j'ai une macro qui me crée une liste unique des noms et une liste unique des années. Dans une nouvelle feuille je copie sur une col les années et je transpose en ligne les noms. Le calcul de la somme et du nombre se fait avec sommeprod. Beaucoup de formules SOMMEPROD alourdissent le fichier (ouverture, recalcul, etc.). Je vais tester ta macro pour s'en passer d'un bon nombre de formules SOMMPROD.

Merci encore
KIM
 

KIM

XLDnaute Accro
Re : Utilisation de Maplage

Re le fil, le forum,
@Job75,
J'ai testé ta dernière macro et t'en remercie. Dans la restitution, il y a un décalage. Le 1er nom se retrouve au dessus des années et sans données. Les autres colonnes de Eric2 à Eric7 sont correctes. J'ai cherché l'erreur mais sans résultat. Si les titres des lignes Somme et nombre créent ce problème, je peux les saisir manuellement.
Merci d'avance
KIM
 

KIM

XLDnaute Accro
Re : Utilisation de Maplage

Re le fil, le forum & Job75,
@néné06,
La liste des titres est correcte, de Eric1 à Eric7. Par contre elle est décalée à gauche, voir fichier joint. En modifiant comme proposé, j'ai une erreur d'exécution '9' au niveau de la bouvle "Reste du remplissage".

Merci d'avance
KIM
 

Pièces jointes

  • KB_Comptage_v5.xlsm
    81.2 KB · Affichages: 20
  • KB_Comptage_v5.xlsm
    81.2 KB · Affichages: 17

job75

XLDnaute Barbatruc
Re : Utilisation de Maplage

Re,

Bah oui j'avais fait une erreur d'indice pour la 1ère ligne, utiliser :

Code:
Sub Traitement()
Dim source As Range, dest As Range, t, d1 As Object, d2 As Object
Dim d3 As Object, i&, ncol%, rest(), a, j%, an%, x$
Set source = [G8].CurrentRegion.Resize(, 4) 'à adapter
Set dest = [L8] 'à adapter
t = source
Set d1 = CreateObject("Scripting.Dictionary") 'année
Set d2 = CreateObject("Scripting.Dictionary") 'nom
Set d3 = CreateObject("Scripting.Dictionary") 'année+nom
d2.CompareMode = vbTextCompare 'la casse est ignorée
d3.CompareMode = vbTextCompare
'---dimensions du tableau rest---
For i = 1 To UBound(t) 'For i = 2 si ligne de titres
  d1(t(i, 1)) = ""
  d2(t(i, 2)) = ""
  d3(t(i, 1) & t(i, 2)) = i 'repérage de la ligne
Next
ncol = d2.Count + 2
ReDim rest(1 To 2 * d1.Count + 1, 1 To ncol)
'---remplissage des 1ère et 2ème colonnes du tableau rest---
a = d1.keys
For i = 2 To UBound(rest) Step 2
  rest(i, 1) = "Somme": rest(i, 2) = a(i / 2 - 1)
  rest(i + 1, 1) = "Nbre": rest(i + 1, 2) = rest(i, 2)
Next
'---remplissage de la 1ère ligne du tableau rest---
a = d2.keys
For j = 3 To ncol
  rest(1, j) = a(j - 3)
Next
'---reste du remplissage---
For i = 2 To UBound(rest) Step 2
  an = rest(i, 2)
  For j = 3 To ncol
    x = an & rest(1, j)
    rest(i, j) = t(d3(x), 3)
    rest(i + 1, j) = t(d3(x), 4)
Next j, i
'---restitution---
Application.ScreenUpdating = True
dest.CurrentRegion.ClearContents 'RAZ
dest.Resize(UBound(rest), ncol) = rest
End Sub
Edit : a = d3.items était inutile...

A+
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
153

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 425
Membres
103 206
dernier inscrit
diambote