Trier une liste par critère à partir d'une base de données
Bonjour à tous !
Voilà, j'ai une base de données et j'aimerais créer un tableau sur une autre feuille pour faire un tri par critère.
Je m'explique :
Sur ma colonne "G" j'ai différentes section par exemple bleu,blanc, rouge ... et dans ma colonne C la désignation d'objet.
J'ai créer sur la feuille 2, les 8 colonnes de couleurs et je voudrais qu'il classe automatiquement les objets (désignation objets) dans les colonnes suivant leurs couleurs renseignées dans ma base de données.
Puis exporter le tableau excel sur word et qu'il fasse une mise a jour auto dès que je renseigne un nouvel objet dans ma base de données.
Si quelqu'un à une solution je suis preneur.
Merci
Cordialement
Bonjour,
pas de fichier, pas de chocolat
P.
Bien sur !
Je vous met un tableau test car je ne peux pas divulguer les informations mais la structure est la même.
Merci
Bonjour,
une manière de faire (si j'ai compris) et probablement imparfaite , j'ai travaillé avec dictionnaire mais je maîtrise mal encore
le code s'active (et efface) la feuille "cible" à chaque activation de cette feuille "cible"
P.
Bonjour,
Premièrement merci d'avoir répondu.
Mais ce n'est pas exactement ce que j'attends.
Peut être avec la fonction rechercher mais je maitrise mal le sujet.
Cordialement
floflo50100 a écrit :Bonjour,
Premièrement merci d'avoir répondu.
Mais ce n'est pas exactement ce que j'attends.
Peut être avec la fonction rechercher mais je maitrise mal le sujet.
Cordialement
Un code avec dictionnaire ira 1000 fois plus vite que des formules sur un grand nombre de lignes !
Tu peux mettre alors un exemple plus complet et proche de la réalité au niveau du résultat demandé ?
On y regardera, si ce n'est pas moi, il y a bien une bonne âme ici qui te proposera une soluce
P.
Bonsoir le forum,
Salut Patrick,
Peut-être comme ceci :
Option Explicit
Sub test()
Dim a, b(), dico As Object, i As Long, t As Byte, n As Long, w()
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets("Feuil1").Range("a1").CurrentRegion
a = .Value
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 6)) Then
t = t + 1
If t > UBound(b, 2) Then
ReDim Preserve b(1 To UBound(b, 1), 1 To t)
End If
b(1, t) = a(i, 6)
dico(a(i, 6)) = VBA.Array(1, t)
End If
w = dico(a(i, 6))
w(0) = w(0) + 1
b(w(0), w(1)) = a(i, 3)
n = Application.Max(n, w(0))
dico(a(i, 6)) = w
Next
End With
With Sheets("Feuil2").Range("a1")
.CurrentRegion.Clear
With .Resize(n, UBound(b, 2))
.Value = b
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 37
End With
.Font.Name = "calibri"
.Font.Size = 10
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.VerticalAlignment = xlCenter
.Columns.AutoFit
End With
.Parent.Activate
End With
End Subklin89
Rebonjour,
Merci kling89 ton code marche très bien.
Je suis vraiment une bille en VBA
Est-il possible dans le code de rajouter la mise forme que j'ai mise en exemple dans la "feuille 3" ?
Elle m'est imposée car je dois lier ce tableau avec un document word.
Merci
Re floflo50100,
Comme ceci :
'Restitution
With Sheets("Feuil2").Range("a1")
.CurrentRegion.Clear
With .Resize(n, UBound(b, 2))
.Value = b
.Font.Name = "calibri"
.Font.Size = 10
.Font.Bold = True
.BorderAround Weight:=xlMedium, ColorIndex:=55
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
With .Borders(xlInsideHorizontal)
.Weight = xlMedium
.ColorIndex = 55
End With
With .Borders(xlInsideVertical)
.Weight = xlMedium
.ColorIndex = 55
End With
With .Rows(1)
.Interior.ColorIndex = 55
With .Font
.ColorIndex = 2
.Name = "Cambria"
.Size = 14
End With
End With
.Columns.AutoFit
End With
.Parent.Activate
End Withklin89