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 15 mars 2023 - 11 janv. 2012 à 10:54
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 15 mars 2023 - 11 janv. 2012 à 10:54
A voir également:
- Tri en masse Excel 2007
- Liste déroulante excel - Guide
- Formule excel - Guide
- Télécharger excel 2007 gratuit - Télécharger - Tableur
- Save as pdf office 2007 - Télécharger - Bureautique
- Déplacer une colonne excel - Guide
25 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
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
15 mars 2023
2 712
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
15 mars 2023
2 712
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
15 mars 2023
2 712
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
15 mars 2023
2 712
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