Tri en masse Excel 2007
Résolu/Fermé
Dauphins
-
6 janv. 2012 à 13:42
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 11 janv. 2012 à 10:54
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 11 janv. 2012 à 10:54
A voir également:
- Tri en masse Excel 2007
- Liste déroulante excel - Guide
- Tri excel - Guide
- Mise en forme conditionnelle excel - Guide
- Renommer fichier en masse - Guide
- Formule excel - Guide
25 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
9 janv. 2012 à 13:38
9 janv. 2012 à 13:38
Alors voici l'ensemble des codes regroupés en deux macros et une fonction...
Durée d'exécution chez moi (pour te donner un ordre d'idée) pour 35 000 lignes : 29 secondes 25 centièmes...
Durée d'exécution chez moi (pour te donner un ordre d'idée) pour 35 000 lignes : 29 secondes 25 centièmes...
Option Explicit Option Base 1 Sub Repartition() Dim DicoConcat As Object Dim concat(), Colonns(), TablDico(), Symb() Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long Dim Wsh As Worksheet Dim Trouve As Range Dim Message As String Dim test As Boolean Application.ScreenUpdating = False '-----------------------------------------------' '------ Effacement des symboles colonne C ------' '-----------------------------------------------' Symb = Array(">", "<", "-", "+", "=", "$") 'tu peux ajouter ici autant de symboles que nécessaire!!! With Sheets("Feuil1") DrLig = .Range("C" & Rows.Count).End(xlUp).Row For Lig = 1 To DrLig For i = LBound(Symb) To UBound(Symb) If InStr(.Cells(Lig, 3), Symb(i)) <> 0 Then .Cells(Lig, 3) = Replace(.Cells(Lig, 3), Symb(i), "") End If Next i Next Lig '------------------------------------------------------------' '-- remplissage des variables avec le contenu de la Feuil1 --' '------------------------------------------------------------' DrLig = .Range("A" & Rows.Count).End(xlUp).Row ReDim concat(DrLig) ReDim Colonns(1 To DrLig, 1 To 6) For i = 2 To DrLig For j = 1 To 6 'Colonns = toutes les données deFeuil1 Colonns(i - 1, j) = .Cells(i, j) Next j 'concat = concaténation des colonnes E & F concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6) Next i End With '-------------------------------------------------------------' '-- Etablit la liste sans doublons des Familles_ss familles --' '-------------------------------------------------------------' Set DicoConcat = CreateObject("Scripting.Dictionary") For i = LBound(concat) To UBound(concat) DicoConcat(concat(i)) = "" Next i '-------------------------------------------------------------' '- Compte si le futur nombre de feuilles est supérieur à 250 -' '-------------------------------------------------------------' If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable." Exit Sub End If '-------------------------------------------------------------' '------ Création des feuilles nommées Famille_Ss Famille -----' '-------------------------------------------------------------' TablDico = DicoConcat.keys 'Si vous souhaitez tester si la feuille a déjà été créée 'enlevez les apostrophes en début des lignes suivantes For i = 0 To UBound(TablDico) - 1 ' If FeuilleExiste(TablDico(i)) = False Then ThisWorkbook.Worksheets.Add With ActiveSheet .Name = TablDico(i) .Range("A1") = "Fournisseur" .Range("B1") = "Ref" .Range("C1") = "Description" .Range("D1") = "Prix" .Range("E1") = "Famille" .Range("F1") = "Sous famille" '-------------------------------------------------------------' '------ remplit les feuilles nommées Famille_Ss Famille ------' '-------------------------------------------------------------' For j = 1 To UBound(concat) If concat(j) = TablDico(i) Then Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row For Col = 1 To 6 .Cells(Lig, Col) = Colonns(j, Col) Next End If Next j End With ' Else ' With Sheets(concat) ' .Cells.Clear ' End With ' End If Next i Sheets("Feuil1").Select '-------------------------------------------------------------' '---- Renomme les feuilles en fonction d'une liste Feuil2 ----' '-------------------------------------------------------------' test = False Message = "Les feuilles suivantes n'ont pas pu être renommées : " & Chr(10) For Each Wsh In ThisWorkbook.Worksheets With Sheets("Feuil2") Set Trouve = .Columns(1).Cells.Find(Wsh.Name, LookAt:=xlWhole) If Trouve Is Nothing Then Message = Message & Chr(10) & Wsh.Name test = True ElseIf Trouve.Offset(0, 1) <> "" Then If FeuilleExiste(Trouve.Offset(0, 1).Value) Then Message = Message & Chr(10) & Trouve.Value test = True Else Wsh.Name = Trouve.Offset(0, 1).Value End If End If Set Trouve = Nothing End With Next If test = True Then MsgBox Message Else MsgBox "Toutes les feuilles ont été renommées" End If End Sub Function FeuilleExiste(NomFeuille) As Boolean Dim f As Object On Error Resume Next Set f = Sheets(NomFeuille) If Err = 0 Then FeuilleExiste = True Set f = Nothing End Function Sub ListeFamillesSousFamilles() Dim DicoConcat As Object Dim concat() Dim DrLig As Long, i As Long, j As Long Application.ScreenUpdating = False With Sheets("Feuil1") DrLig = .Range("A" & Rows.Count).End(xlUp).Row ReDim concat(DrLig) For i = 2 To DrLig concat(i - 1) = .Cells(i, 5) & "_" & .Cells(i, 6) Next i End With Set DicoConcat = CreateObject("Scripting.Dictionary") For i = LBound(concat) To UBound(concat) DicoConcat(concat(i)) = "" Next i With Sheets("Feuil2") .Range("A1").Resize(DicoConcat.Count) = Application.Transpose(DicoConcat.keys) End With End Sub
Ok mais cela ne renomme pas. Comment dois-je faire pour mettre les noms de remplacement et qu'il le fasse automatiquement ?
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
9 janv. 2012 à 16:44
9 janv. 2012 à 16:44
Pour réaliser le tout, 3 étapes :
1- tu lances la macro ListeFamillesSousFamilles
2- en feuil2 Colonne B tu mets tes noms de feuille : pomme, poire banane ...
3- tu lances la macro Repartition
1- tu lances la macro ListeFamillesSousFamilles
2- en feuil2 Colonne B tu mets tes noms de feuille : pomme, poire banane ...
3- tu lances la macro Repartition
Cela ne fonctionne pas. Quand je lance Répartition, il m'ouvre une fenêtre me listant toutes les fenêtres n'ayant pas pu être renommées, bref toutes. Quand je la ferme il me tri quand même les références
N'est il pas possible que la fenêtre 2 sois déjà écrite dès le départ afin d'éviter aux personnes utilisant cela de tout faire à chaque fois a la main ?
N'est il pas possible que la fenêtre 2 sois déjà écrite dès le départ afin d'éviter aux personnes utilisant cela de tout faire à chaque fois a la main ?
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
10 janv. 2012 à 08:43
10 janv. 2012 à 08:43
Bonjour,
Si tu suis les 3 étapes mentionnées ci dessus, tout fonctionne.
En fait, les trois cas ou les feuilles ne sont pas renommées sont :
- le nouveau de nom de feuille (pomme par exemple) existe déjà dans ce même classeur,
- le "couple" Famille-Sous Famille n'a pas été trouvé Feuil2
- Si la colonne B Feuil2 n'est pas remplie pour le couple Famille-sous famille concerné.
On peux tout automatiser, si tu le souhaites. Je crois avoir compris que tes noms de feuilles (pomme, poire, banane...) ne sont pas donnés au hasard, et sont, en fait, des extraits des noms de familles (ou de sous familles). Si tu veux que la macro fasse tout toute seule, dis moi comment sont construits ces noms de feuilles (pomme, poire)?
Si tu suis les 3 étapes mentionnées ci dessus, tout fonctionne.
En fait, les trois cas ou les feuilles ne sont pas renommées sont :
- le nouveau de nom de feuille (pomme par exemple) existe déjà dans ce même classeur,
- le "couple" Famille-Sous Famille n'a pas été trouvé Feuil2
- Si la colonne B Feuil2 n'est pas remplie pour le couple Famille-sous famille concerné.
On peux tout automatiser, si tu le souhaites. Je crois avoir compris que tes noms de feuilles (pomme, poire, banane...) ne sont pas donnés au hasard, et sont, en fait, des extraits des noms de familles (ou de sous familles). Si tu veux que la macro fasse tout toute seule, dis moi comment sont construits ces noms de feuilles (pomme, poire)?
Bonjour, je viens de réessayé et cela ne fonctionne pas. Je lance la première macro, dans la feuille 2 il me créait une liste en colonne A, donc en B je mets en face des noms, banane, pomme...
Je lance ensuite la deuxième macro et cela me produit une fenêtre pour m'indiquer que toute n'ont pas pu être renommée, et me fait le tri.
Est-il possible que dans le code tu mets par défaut 2_1 = banane.... ? Comme cela tout est automatique.
Je lance ensuite la deuxième macro et cela me produit une fenêtre pour m'indiquer que toute n'ont pas pu être renommée, et me fait le tri.
Est-il possible que dans le code tu mets par défaut 2_1 = banane.... ? Comme cela tout est automatique.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
10 janv. 2012 à 12:39
10 janv. 2012 à 12:39
Oui, donne moi la liste des correspondances pour tous les cas...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
11 janv. 2012 à 10:54
11 janv. 2012 à 10:54
Bonjour,
Problème résolu par MP, du à un souci sur les données, présence de caractères spéciaux dans les noms de feuilles...
La macro finale semble donc bien "tourner".
Voici son code, au cas ou... :
Problème résolu par MP, du à un souci sur les données, présence de caractères spéciaux dans les noms de feuilles...
La macro finale semble donc bien "tourner".
Voici son code, au cas ou... :
Option Explicit Option Base 1 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++' '----- SOURCES Pédagogiques : '- Pour les variables tableaux : 'http://boisgontierjacques.free.fr/pages_site/tableaux.htm 'http://silkyroad.developpez.com/vba/tableaux/ '- Pour les objets Dictionary (merci Michel_m ;-)) : 'http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm '- Pour le tri des onglets : 'http://www.commentcamarche.net/forum/affich-3356070-vba-trier-les-feuilles#1 'En général : 'http://www.commentcamarche.net/forum/ 'et en particulier pour la Function FeuilleExiste : 'http://www.developpez.net/forums/f542/logiciels/microsoft-office/excel/ '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++' Sub Repartition() Dim DicoConcat As Object Dim concat(), Colonns(), TablDico(), Symb() Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long Dim Boucle As Integer, Compteur As Integer Dim Wsh As Worksheet Dim Trouve As Range Dim Message As String Dim test As Boolean Dim t t = Timer Application.ScreenUpdating = False '------------------------------------------------------' '------ Effacement des symboles colonne C Feuil1 ------' '------------------------------------------------------' Symb = Array(">", "<", "-", "+", "=", "$") 'tu peux ajouter ici autant de symboles que nécessaire!!! With Sheets("Feuil1") DrLig = .Range("C" & Rows.Count).End(xlUp).Row For Lig = 1 To DrLig For i = LBound(Symb) To UBound(Symb) If InStr(.Cells(Lig, 3), Symb(i)) <> 0 Then .Cells(Lig, 3) = Replace(.Cells(Lig, 3), Symb(i), "") End If Next i Next Lig '------------------------------------------------------------' '-- remplissage des variables avec le contenu de la Feuil1 --' '------------------------------------------------------------' DrLig = .Range("A" & Rows.Count).End(xlUp).Row ReDim concat(DrLig) ReDim Colonns(1 To DrLig, 1 To 6) For i = 2 To DrLig For j = 1 To 6 'Colonns = toutes les données deFeuil1 Colonns(i - 1, j) = .Cells(i, j) Next j 'concat = concaténation des colonnes E & F concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6) Next i End With '-------------------------------------------------------------' '-- Etablit la liste sans doublons des Familles_ss familles --' '-------------------------------------------------------------' Set DicoConcat = CreateObject("Scripting.Dictionary") For i = LBound(concat) To UBound(concat) DicoConcat(concat(i)) = "" Next i '-------------------------------------------------------------' '- Compte si le futur nombre de feuilles est supérieur à 250 -' '-------------------------------------------------------------' If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable." Exit Sub End If '-------------------------------------------------------------' '------ Création des feuilles nommées Famille_Ss Famille -----' '-------------------------------------------------------------' TablDico = DicoConcat.keys For i = 0 To UBound(TablDico) - 1 '-------------------------------------------------------------' '------ Cas d'une feuille déjà existante - TEST cf + bas -----' '------ Si vous souhaitez ajouter ce test de sécurité à ------' '------ la procédure, enlevez les ' en début des lignes ------' '------ référencées par 'suppr(') en fin de ligne... ---------' '-------------------------------------------------------------' ' If FeuilleExiste(TablDico(i)) = False Then 'suppr(') ThisWorkbook.Worksheets.Add With ActiveSheet .Name = TablDico(i) .Range("A1") = "Fournisseur" .Range("B1") = "Ref" .Range("C1") = "Description" .Range("D1") = "Prix" .Range("E1") = "Famille" .Range("F1") = "Sous famille" '-------------------------------------------------------------' '------ remplit les feuilles nommées Famille_Ss Famille ------' '-------------------------------------------------------------' For j = 1 To UBound(concat) If concat(j) = TablDico(i) Then Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row For Col = 1 To 6 .Cells(Lig, Col) = Colonns(j, Col) Next End If Next j End With '-------------------------------------------------------------' '------ Cas d'une feuille déjà existante - Cf test + haut ----' '--- On supprime tout ce qu'elle contenait et on la remplit --' '-------------------------------------------------------------' ' Else 'suppr(') ' With Sheets(concat) 'suppr(') ' .Cells.Clear 'suppr(') ' .Range("A1") = "Fournisseur" 'suppr(') ' .Range("B1") = "Ref" 'suppr(') ' .Range("C1") = "Description" 'suppr(') ' .Range("D1") = "Prix" 'suppr(') ' .Range("E1") = "Famille" 'suppr(') ' .Range("F1") = "Sous famille" 'suppr(') ' For j = 1 To UBound(concat) 'suppr(') ' If concat(j) = TablDico(i) Then 'suppr(') ' Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row 'suppr(') ' For Col = 1 To 6 'suppr(') ' .Cells(Lig, Col) = Colonns(j, Col) 'suppr(') ' Next 'suppr(') ' End If 'suppr(') ' Next j 'suppr(') ' End With 'suppr(') ' End If 'suppr(') Next i Sheets("Feuil1").Select '-------------------------------------------------------------' '---- Renomme les feuilles en fonction d'une liste Feuil2 ----' '-------------------------------------------------------------' test = False Message = "Les feuilles suivantes n'ont pas pu être renommées : " & Chr(10) For Each Wsh In ThisWorkbook.Worksheets With Sheets("Feuil2") Set Trouve = .Columns(1).Cells.Find(Wsh.Name, LookAt:=xlWhole) If Trouve Is Nothing Then Message = Message & Chr(10) & Wsh.Name test = True ElseIf Trouve.Offset(0, 1) <> "" Then If FeuilleExiste(Trouve.Offset(0, 1).Value) Then Message = Message & Chr(10) & Trouve.Value test = True Else Wsh.Name = Trouve.Offset(0, 1).Value End If Else Message = Message & Chr(10) & Trouve.Value test = True End If Set Trouve = Nothing End With Next '-------------------------------------------------------------' '-------- Trie les feuilles dans l'ordre alphabétique --------' '-------------------------------------------------------------' For Boucle = 1 To Sheets.Count If Sheets(Boucle).Visible = True Then For Compteur = 1 To (Boucle - 1) If Sheets(Compteur).Visible = True Then If (UCase(Sheets(Boucle).Name) < UCase(Sheets(Compteur).Name)) Then Sheets(Boucle).Move before:=Sheets(Compteur) Exit For End If End If Next Compteur End If Next Boucle Sheets("Feuil1").Select '-------------------------------------------------------------' '--------- Fin de la macro / message à l'utilisateur ---------' '-------------------------------------------------------------' If test = True Then MsgBox "Procédure terminée en : " & Timer - t & " Secondes!" & Chr(10) & Message Else MsgBox "Procédure terminée en : " & Timer - t & " Secondes!" & Chr(10) & "Toutes les feuilles ont été renommées" End If End Sub Function FeuilleExiste(NomFeuille) As Boolean Dim f As Object On Error Resume Next Set f = Sheets(NomFeuille) If Err = 0 Then FeuilleExiste = True Set f = Nothing End Function