Tableau à répartir selon critères
Bonjour Forum,
Voilà, j'ai besoin de votre aide pour répartir un tableau sur plusieurs onglets dans Excel selon 3 critères:
- onglet 1 des crédit investissement & fonctionnement
- onglet 2 des crédits fonctionnement
- onglet 3 des crédits d'investissement
Je veux pouvoir répartir ce tableau en 3 onglets en fonction de la nature crédit, exemple :
1- si une donnée en colonne F dispose de 2 natures différentes alors je copies l'ensemble des lignes dans (l'onglet 1)
2- si la donnée en colone F dispose d'une seule nature (exemple : crédit fonctionnenement) alors je copies l'ensemble des lignes dans l'onglet approprié (onglet2)
3- si la donnée en colone F dispose d'une seule nature (exemple : crédit d'investissement) alors je copies l'ensemble des lignes dans l'onglet approprié (onglet 3)
et ainsi de suite jusqu'au dernier ligne du tableau.
J'ai le fichier dans lien ci-dessous un exemple avec détail de ce que je souhaite avoir,
svp je n'arrive pas à répatir le tableau avec les filtres et la recherche car je trouve une différence entre le tableau initiale somme de la colonne H et les sommes des onglets de même colonne .
Merci d'avance.
Bonjour,
il est préférable de déposer le fichier ici et pas dans un programme externe d'où il disparaîtra assez vite
P.
Une tentative ici
Bonjour le fil, bonjour le forum,
Josef, la solution que je te propose implique un peu plus de cohérence entre la Nature et le nom des onglets. En effet, parfois dans Nature tu avais mis un espace à la fin, parfois non. Difficile de faire correspondre Nature et onglet !... J'ai donc créer une liste de validation de données qui oblige l'utilisateur à sélectionner un valeur sans équivoque. Puis, j'ai renommé les onglets pour qu'il y ait correspondance entre les deux.
Le code après et relativement simple :
Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet de Base)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim OS As Worksheet 'déclare la variable OS (OngletS)
Dim L As Integer 'déclare la variable L (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet de Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
'éfface d'éventuelle ancienne données
Sheets("Crédit Invest & FCT").Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'pas sûr ? Supprime cete ligne si tu veux garder les anciennes données
Sheets("Crédit Fonctionnement").Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'pas sûr ? Supprime cete ligne si tu veux garder les anciennes données
Sheets("Crédit d'Investissement").Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'pas sûr ? Supprime cete ligne si tu veux garder les anciennes données
Set OB = Sheets("31 DEC 2016") 'définit l'onglet de base OB
TV = OB.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
D(TV(I, 6)) = TV(I, 6) 'alimente le dictionnaire D avec les valeurs en colonne 6 de TV (=> colonne F)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
D.RemoveAll 'vide les éléments du dictionnaire D
Erase TL 'efface le tableau des lignes TL
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
If TV(I, 6) = TMP(J) Then 'si la donnée ligne I colonne 6 de TV est égale à la valeur de la variable TMP(J)
D(TV(I, 7)) = TV(I, 7) 'alimente le dictionnaire D avec les élément de la colonne 7 de TV (=> colonne G)
For Each OS In Sheets 'boucle 3 : sur tous les onglets OS du classeur
'si le nom de l'onglet OS est égale à TV(I,7), définit l'onglet de destination OD et sort de la boucle 3
If TV(I, 7) = OS.Name Then Set OD = OS: Exit For
Next OS 'prochain onglet de la boucle 3
ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des ligns TL(autant de lignes que TV a de colonnes, K colonnes)
For L = 1 To UBound(TV, 2) 'boucle 4 : sur toutes les colonnes de TV
TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la donnée en colonne L de TV (= Transposition)
Next L 'prochaine colonne de la boucle 1
K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle 2
If K > 1 Then 'condition : si K est supérieure à 1
If D.Count > 1 Then Set OD = Sheets("Crédit Invest & FCT") 'si D contient plus d'un seul élément, redéfinit l'onglet OD
Set DEST = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
DEST.Resize(UBound(TL, 2), UBound(TV, 2)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If ' fin de la condition
Next J 'prochaine= élément de la boucle 1
End SubÇa évite une usine à gaz pour retrouver l'onglet en fonction de la nature...
Tu n'as pas précisé ce qu'il fallait faire si on exécute la macro plusieurs fois. Garder les anciennes données après répartition ou réinitialiser les tableaux de répartition. Actuellement, le code réinitialise...
Dernière remarque, tu parles de calculs mais méfie toi car dans la base tu n'affiche pas les décimales. C'est peut être pour ça que tu as des différences,,,
Le fichier :