Tableaux de données

Bonjour,

Ci-joint un fichier excel pour illustrer ma question.

Je souhaiterais à partir des données contenue dans l’onglet Données obtenir les tableaux contenus dans l’onglet resultat en sachant que le nombre de classe, de matière et d’enseignant est variable.

Merci pour votre aide

Nadjate

Question excel.xlsx (11.6 KB)

···

De : Docteur Excel formuleexcel=discoursehosting.net@mail101.suw11.mcdlv.net De la part de Docteur Excel
Envoyé : vendredi 13 avril 2018 14:47
À : nhassani@orgmansolutions.com
Objet : Quelle est ta question Excel/VBA?

Bonjour c’est Docteur Excel!

Es-tu bloqué sur Excel ou VBA? Comment puis-je t’aider?

Pose-moi ta question et je te répondrai dans les plus brefs délais (pour cela réponds directement à cet email).

Si tu préfères tu peux la poser sur mon forum: https://FormuleExcel.us11.list-manage.com/track/click?u=529a386eb12681c8f0601cd6d&id=46b09bcffd&e=0846b606c4 http://forum.formuleexcel.com

Dans les jours qui suivent je t’enverrai quelques tutoriels afin d’améliorer ta maîtrise d’Excel

A bientôt,
Docteur Excel

https://FormuleExcel.us11.list-manage.com/unsubscribe?u=529a386eb12681c8f0601cd6d&id=27522182d1&e=0846b606c4&c=ded5c36b6f Se désinscrire

Copyright © 2018 Outwork OÜ

Vous recevez ce mail car vous vous êtes inscrit sur FormuleExcel.com

Outwork OÜ

Sepapaja Tn 6, Lasnamäe Linnaosa

Tallinn 15551

Estonia

<file://FormuleExcel.us11.list-manage.com/vcard%3fu=529a386eb12681c8f0601cd6d&id=27522182d1> Add us to your address book

http://www.mailchimp.com/monkey-rewards/?utm_source=freemium_newsletter&utm_medium=email&utm_campaign=monkey_rewards&aid=529a386eb12681c8f0601cd6d&afl=1

Bonjour,

Avec un simple Tableau Croisé Dynamique, on arrive sensiblement au même résultat
Sinon, c’est passer par du VBA et avec les cellules fusionnées, c’est plus la même :thinking:

Question excel.xlsx (16,7 Ko)

Et une autre disposition, en inversant les champs “Enseignant” & “Matières” sur le TCD

Question excel Vers2.xlsx (17,8 Ko)

Bonjour,

En fait je souhaite vraiment avoir la vue tel que définie dans le tableau en A4:D8.
Je me doutais que la macro allait etre nécessaire d’ou ma demande d’aide.

Merci

Bonjour,

C’est qui qui répond, et c’est qui qui pose des questions ?? :thinking:

C’est nhassani
ou
c’est Natie

Moi, c’est Mimimathy et je ne change pas de nom à chaque réponse :wink:

Bonjour,

A tester

La macro

Sub Regroupe()
  Application.ScreenUpdating = False
  'Déclaration des variables
  Set F = Sheets("Données")
  BD = F.Range("A2:D" & F.[A65000].End(xlUp).Row).Value
  colCrit1 = 1
  colCrit2 = 2
  colCrit3 = 3
  colCrit4 = 4
  Set Result = Sheets("Resultat").Range("A4")
  'Boucle sur les colonnes
    For i = LBound(BD) To UBound(BD)
      BD(i, colCrit4) = F.Cells(i + 1, colCrit3).Font.ColorIndex
    Next i
  'Vide la feuille Resultat
  Result.CurrentRegion.ClearContents
  'Déclaration des dictionnaires (rapidité)
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  'Boucle sur les résultats des dicos
    For i = LBound(BD) To UBound(BD)
      tmp = BD(i, colCrit2): If d1.exists(tmp) Then lig = d1(tmp) Else d1(tmp) = d1.Count + 1: lig = d1.Count
      tmp = BD(i, colCrit1): If d2.exists(tmp) Then col = d2(tmp) Else d2(tmp) = d2.Count + 1: col = d2.Count
      x = Len(Result.Offset(lig, col))
      Result.Offset(lig, col).Characters(Start:=x + 1, Length:=1).Text = BD(i, colCrit3) & Chr(10)
    Next i
  'Recopie des données dans la feuille Résultat
  Result.Offset(1).Resize(d1.Count) = Application.Transpose(d1.keys)
  Result.Offset(, 1).Resize(, d2.Count) = d2.keys
  Sheets("Resultat").Activate
End Sub

Question excel.xlsm (22,8 Ko)

Bonjour mimimathy,

Désolée pour la confusion et le dédoublement de personalité.
J’ai posé ma question avant de m’inscrire donc sans choisir le pseudo et en voulant te repondre j’en ai choisi un.

Donc désormais je suis et reste natie.

Merci pour ton aide je teste ta macro ca sur mon fichier de 3000 lignes et te tiens au courant

Merci

1 « J'aime »

Bonjour Mimimathy,

Je te remercie pour ta macro et j’aurais à nouveau besoin de ton aide.
En effet, je dois utiliser cette macro sur Excel 2007 or la ligne
Result.Offset(lig, col).Characters(Start:=x + 1, Length:=1).Text = BD(i, colCrit3) & Chr(10)
me renvoie le message d’erreur “Impossible de définir la propriété Text de la classe Characters” (alors que cela fonctionne tres bien sur excel 365).
Merci de ton aide (ca fait 4 jours que je me tords la tete avec cette macro et pas que sur ce point.)

Bonne journée

Bonjour @Natie,

Bon je ne m’y connais pas autant que @Mimimathy en VBA, mais j’ai peut-être trouvé une solution.

A tester:

Remplace Chr(10) par vbCrLf ça a l’air de fonctionner.

Code modifié:

Sub Regroupe()
  Application.ScreenUpdating = False
  'Déclaration des variables
  Set F = Sheets("Données")
  BD = F.Range("A2:D" & F.[A65000].End(xlUp).Row).Value
  colCrit1 = 1
  colCrit2 = 2
  colCrit3 = 3
  colCrit4 = 4
  Set Result = Sheets("Resultat").Range("A4")
  'Boucle sur les colonnes
    For i = LBound(BD) To UBound(BD)
      BD(i, colCrit4) = F.Cells(i + 1, colCrit3).Font.ColorIndex
    Next i
  'Vide la feuille Resultat
  Result.CurrentRegion.ClearContents
  'Déclaration des dictionnaires (rapidité)
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  'Boucle sur les résultats des dicos
    For i = LBound(BD) To UBound(BD)
      tmp = BD(i, colCrit2): If d1.exists(tmp) Then lig = d1(tmp) Else d1(tmp) = d1.Count + 1: lig = d1.Count
      tmp = BD(i, colCrit1): If d2.exists(tmp) Then col = d2(tmp) Else d2(tmp) = d2.Count + 1: col = d2.Count
      x = Len(Result.Offset(lig, col))
      Result.Offset(lig, col).Characters(Start:=x + 1, Length:=1).Text = BD(i, colCrit3) & vbCrLf 'Chr(10)
    Next i
  'Recopie des données dans la feuille Résultat
  Result.Offset(1).Resize(d1.Count) = Application.Transpose(d1.keys)
  Result.Offset(, 1).Resize(, d2.Count) = d2.keys
  Sheets("Resultat").Activate
End Sub

Fichier en retour ICI==> Question excel.xlsm (22,0 Ko)

Cordialement.

1 « J'aime »

Bonjour,
Salut MDO,

Bien vu, c’est vrai quand étant sur EXCEL 2013 le CHR(10) passe, mais déjà sur 2010, il bugue :star_struck:

Salut @Mimimathy, :wink:

Merci, mais j’ai juste recherché une solution à CHR(10) et c’est toi qui a fait tout le boulot.

Je suis sur Excel 2010 et avec ta solution, ça fonctionne correctement, donc ça doit être juste pour la version 2007 et inférieur.

Cordialement.

Bonjour à tous les deux

Merci pour votre solution.
Je vous aurais bien mon fichier initial mais il est lié à plusieurs autres fichiers et comporte de nombreuses macros ; il fait à peu pres 25 Mo sans les fichiers annexes.
Malheuresement je ne suis plus au bureau donc impossible de verifier votre solution (je n’ai que office 365 chez moi)

Le message d’erreur s’affiche lorsque la boucle essaie d’ajouter à une même cellule trop de lignes (ou caractères ?)
En effet, je peux avoir à ajouter jusqu’à 20 lignes dont chacune peut faire jusqu’à 50 caractères.

Une idée qui permettrait de tester à la maison sans installer une autre version Excel ?
Je dois rendre le fichier final demain matin et je désespere…

Natie

Bonjour,

Pour information j’ai reussi à contourner la limitation en modifiant la macro de cette maniere :

Dim char As String
For i = LBound(BD) To UBound(BD)
tmp = BD(i, colCrit1): If d1.exists(tmp) Then lig = d1(tmp) Else d1(tmp) = d1.Count + 1: lig = d1.Count
tmp = BD(i, colCrit1): If d2.exists(tmp) Then col = d2(tmp) Else d2(tmp) = d2.Count + 1: col = d2.Count
char = Result.Offset(lig, col).Value
char = BD(i, colCrit6) & vbCrLf & char
Result.Offset(lig, col).Value = char
Next i

Merci de votre aide.

Natie :sunny: :smile: