Boucle Do while
Fermé
BK77
Messages postés
2
Date d'inscription
lundi 23 février 2015
Statut
Membre
Dernière intervention
24 février 2015
-
23 févr. 2015 à 18:36
BK77 Messages postés 2 Date d'inscription lundi 23 février 2015 Statut Membre Dernière intervention 24 février 2015 - 24 févr. 2015 à 12:08
BK77 Messages postés 2 Date d'inscription lundi 23 février 2015 Statut Membre Dernière intervention 24 février 2015 - 24 févr. 2015 à 12:08
1 réponse
ThauTheme
Messages postés
1442
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
29 juillet 2022
160
Modifié par ThauTheme le 24/02/2015 à 00:29
Modifié par ThauTheme le 24/02/2015 à 00:29
Bonsoir BK, bonsoir le forum,
Une proposition avec le code ci-dessous :
À plus,
ThauTheme
Une proposition avec le code ci-dessous :
Sub Macro1() Dim LV As Worksheet 'déclare la variable LV (Liste des Villes) Dim MA As Worksheet 'déclare la variable MA (MAquette) Dim TC As Variant 'déclare la variable TC (Tableau de Cellules) 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 ND As Worksheet 'déclare la variable ND (Nouveau Département) Dim J As Integer 'déclare la variable J (incrément) Dim TV() As Variant 'déclare la variable TV (Tableau des Villes) Dim K As Integer 'déclare la variable K (incrément) Set LV = Sheets("liste de villes") 'définit l'onglet LV Set MA = Sheets("maquette") 'définit l'onglet MA TC = LV.Range("A1").CurrentRegion 'définit le tableau de cellules TC Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D '**************************************** 'extraction des départements sans doublon '**************************************** For I = 1 To UBound(TC, 1) 'boucle sur toutes les lignes du tableau de cellules TC D(TC(I, 1)) = "" 'alimente le dictionnaire D avec les départements (en colonne 1 de TC) 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 '************************************ 'création des onglets par département '************************************ For I = 0 To UBound(TMP, 1) 'boucle sur tous les éléments du tableau TMP (les départements) On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante) Set ND = Sheets(TMP(I)) 'définit l'onglet ND avec l'élément I du tableau TMP (génère une erreur si cet onglet n'existe pas) 'permet d'éviter le bug avec un onglet déjà existant... If Err <> 0 Then 'condition : si une erreur a été générée (ce qui devrait être normalement le cas) Sheets("maquette").Copy After:=Sheets(Sheets.Count) 'copie l'onglet maquette en dernière position dans le classeur ActiveSheet.Name = TMP(I) 'renomme l'onglet copié avec le nom de l'élément I tu tableau TMP (le département) End If 'fin de la condition On Error GoTo 0 'annule la gestion des erreurs Next I 'prochain élément de la boucle '*************************************** 'récupération des villes par département '*************************************** For J = 0 To UBound(TMP, 1) 'boucle 1 : sur tous les éléments du tabelau TMP (les départements) Erase TV 'efface le tableau des villes TV K = 0 'initialsie la variable K 'permet de relancer la macro sans doublonner les données Sheets(TMP(J)).Range("A1").CurrentRegion.Clear 'efface d'éventuelles anciennes données dans l'onglet Sheets(TMP(J)).Range("A1").Value = "Ville" 'écrit "Ville dans la cellule A1 de l'onglet For I = 1 To UBound(TC, 1) 'boucle 2 : sur toutes les lignes du tableau de cellules TC If TC(I, 1) = TMP(J) Then 'condition : si la valeur ligne I colonne 1 du tableau TC est égale au département du tableau TMP K = K + 1 'inrémente K ReDim Preserve TV(1 To K) 'redimentionne le tableau des villes TV TV(K) = TC(I, 2) 'récupère dans le tableau des villes TV, la ville en ligne I, colonne 2 du tableau TC End If 'fin de la condition Next I 'prochaine ligne de la boucle 2 Select Case K 'agit en fonction de K Case 0 'si K vaut zéro rien ne se passe Case 1 'si K vaut un (car Application.Tranpose génère une erreur avec un tableau à une seule entrée) Sheets(TMP(J)).Range("A2").Value = TV(1) 'renvoie la ville TV(1) en A2 de l'onglet du département Case Else 'tous les autres cas 'renvoie dans la cellule A2 redimensionnée de l'onglet du département le tableau des villes TV transposé Sheets(TMP(J)).Range("A2").Resize(UBound(TV, 1), 1).Value = Application.Transpose(TV) End Select 'fin de l'action en fonction de K Next J 'prochain département de la boucle 1 End Sub
À plus,
ThauTheme
24 févr. 2015 à 12:08