Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

trier une base pour creer des listes dynamiques

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Z

Zilba456

XLDnaute Nouveau
bonjour j'ai creer une macro pour trier et copier du texte dans une nouvelle feuille afin de pouvoir creer des listes déroulantes qui ce mettrons à jour à chaque démarrage du classeur.
La procédure est relativement lente !
VB: 
Sub Liste()
'
' Liste Macro
'

'trier la source par critère et la coller dans la feuille liste par catégorie afin d'avoir une base pour creer des liste déroulante mise a jour
'par l'ajout d'un nouvelle article en mettant la macro dans l'ouverture du classeur
'
'

    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="sac a dos"
    Columns("a").Select
    Selection.Copy
    Sheets("liste").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="pochettes"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("B2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="liner"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("C2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="sac etanche"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("D2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="tente"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("E2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="sol"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("f2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="piquets"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("G2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="haubans"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("H2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="sursac"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("i2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="sac de couchages"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("j2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="drap"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("k2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="matelas"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("l2").Select
    ActiveSheet.Paste
    Sheets("Matos").Select
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2
    ActiveSheet.ListObjects("Tsource").Range.AutoFilter Field:=2, Criteria1:="bouteille"
    Columns("a").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("liste").Select
    Range("M2").Select
    ActiveSheet.Paste
    Rows("2,0").Delete
End Sub

as-t-il un moyen de simplifié ce code ?
je débute en Vba!
 
Solution
Bonjour,

cf pj


Tri et nomme les listes


VB: 
Sub gListes()
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To [tsource].Rows.Count
     clé = [tsource].Item(i, 2)
     Item = [tsource].Item(i, 1)
     d(clé) = d(clé) & Item & "|"
  Next i
  col = 5
  Cells(1, col).Resize(, d.Count) = d.keys
  For Each k In d.keys
    tmp = d(k)
    a = Split(tmp, "|")
    Cells(2, col).Resize(UBound(a)) = Application.Transpose(a)
    Cells(2, col).Resize(UBound(a)).Sort key1:=Cells(2, col), Header:=xlNo
    ActiveWorkbook.Names.Add Name:=Replace(k, " ", "_"), RefersTo:=Cells(2, col).Resize(UBound(a))
    col = col + 1
  Next k
End Sub

Crée des listes sous forme de...
Trier par date Trier par votes
Bonjour,

cf pj


Tri et nomme les listes


VB: 
Sub gListes()
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To [tsource].Rows.Count
     clé = [tsource].Item(i, 2)
     Item = [tsource].Item(i, 1)
     d(clé) = d(clé) & Item & "|"
  Next i
  col = 5
  Cells(1, col).Resize(, d.Count) = d.keys
  For Each k In d.keys
    tmp = d(k)
    a = Split(tmp, "|")
    Cells(2, col).Resize(UBound(a)) = Application.Transpose(a)
    Cells(2, col).Resize(UBound(a)).Sort key1:=Cells(2, col), Header:=xlNo
    ActiveWorkbook.Names.Add Name:=Replace(k, " ", "_"), RefersTo:=Cells(2, col).Resize(UBound(a))
    col = col + 1
  Next k
End Sub

Crée des listes sous forme de tableaux nommés


Boisgontier
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
406
xavieralvaro
X
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
1 K
telemarrk
T
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
340
sylvanu
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
653
ph.vanne
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
718
robpellan52
R
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
700
Usine à gaz
B
  • Question Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
861
Compte Supprimé 979
C
G
  • Résolu(e)
XL 2016 VBA : Copie d'une ligne après application d'un filtre
Réponses
7
Affichages
1 K
gfgghbhg
G
  • Question Question
Autres Simplifier une macro
Réponses
1
Affichages
429
fanch55
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
3 K
AtTheOne
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
955
Phil69970
B
  • Question Question
Microsoft 365 Colorer les Lignes coller
Réponses
4
Affichages
914
bd.afaf
B
M
  • Question Question
XL 2019 Optimisation VBA
Réponses
1
Affichages
494
vgendron
B
  • Question Question
Microsoft 365 colorer une plage
Réponses
2
Affichages
901
bd.afaf
B
C
  • Question Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
554
Cheyenne_2021
C
B
  • Question Question
Microsoft 365 Copie des données
Réponses
0
Affichages
624
bd.afaf
B
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
948
MickaeL_D
M
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
4 K
fanou06
F
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
A
  • Résolu(e)
XL 2013 Utilisation de plusieurs conditions
Réponses
7
Affichages
1 K
AnjyD
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…