Microsoft 365 Fleurissement.

blancolie

XLDnaute Impliqué
regarde l'onglet BDD-technique et vous allez surment comprendre que l'énorme tableau peut être difficile à lire. quelques fois, on a souvent envie de rechercher un plante par rapport à un critère.
je veux refaire le même fichier avec ce tableau plus grand que j'expliquerais ds une autre discussion avec un onglet en plus qui sera particulier.
 

Fichiers joints

blancolie

XLDnaute Impliqué
Comment puis je faire adapter ton systeme de filtrage si je veux rajouter d'autres critères ? ton code me plait bien par rapport a ce que je peux trouver sur d'autres sites. c'est en faisant des expériences qu on apprend.
 

blancolie

XLDnaute Impliqué
bonjour job,

je pense que tu ne donnera pas suite à mon message mais j'essaye de comprendre ton code pour rajouter une critère ou plusieurs maispour toi je bricole mais pour moi ton code est intéressant car celui que j'ai mis en place filtre mais cela cache uniquement les lignes qu'on ne souhaite pas voir.

moi j'aimerais rajouter les couleurs ( il peut avoir dans une plante 2 couleurs : rouge et orange, donc il faudrait que cela soit pris en compte lors qu'on tape rouge toute les plantes rouge apparaissent mais celles dont l'orange est associé.) hauteur , marche ( bpu.catalogu et tarif) faudrait egalement que quand on tape le fournisseur + plante +couleur, le filtre fonctionne.

voila l'interprétation de ton code :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:F]) Is Nothing Then Exit Sub
Dim vide As Boolean, fournisseur$, couleur$, critere$, tablo, resu(), i&, n&
vide = [B2] & [C2] & [D2] & [E2] = ""
fournisseur = [B2]
couleur = [D2]
critere = LCase(fournisseur & Chr(1) & CStr([C2])) & "*"  'textes commenant par C2....
tablo = Sheets("BDD_Technique").[A2].CurrentRegion.Resize(, 6) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 7)
For i = 2 To UBound(tablo)
    If Not vide And LCase(IIf(fournisseur = "", "", tablo(i, 4)) & Chr(1) & tablo(i, 1)) Like critere Then
        n = n + 1
        resu(n, 1) = tablo(i, 4) 'Numero 4 = Fournisseur / resu(n, 1) = B
        resu(n, 2) = tablo(i, 1) 'Numero 1 = plante /resu(n, 2) = C
        resu(n, 3) = tablo(i, 2) 'Numero 2 = couleur/resu(n, 3) = D
        resu(n, 4) = tablo(i, 5) 'Numéro 5 = contenance / resu(n, 4) =E
        resu(n, 5) = tablo(i, 6)  'Numero 6 = Marché / resu(n, 5) =F
    End If
merci de ton aide
 
Dernière édition:

blancolie

XLDnaute Impliqué
Bonjour job,

j'essaye de comprendre ce code suivant que tu as crée ds thisworksbook car j'ai du l'adapté à un autre fichier et c'est surtout le texte orange.

Rc c'est quand on utilise une formule et les références absolues, c'est bien cela ?

la columns(1) c'est bien dans les onglets devis du fichier fleurissement mais représente quoi et idem pour columns(2) ?
Rc[-5] me donne la colonne L(quantité) c'est bien cela ?
BDD_Fleurs!C1:C7,7,0) ; C1:C7,7,0) , c'est apparement la colonne des couleurs après 7 et 0 je ne vois pas que c'est.
Columns(2) = "=RC[-4]*RC[-1]" 'Quantit_ x Prix U.H.T
Merci pour tes explications


VB:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Devis*" Then Exit Sub
Dim i&
Application.ScreenUpdating = False
With Sh
    .[B:C].Copy .[J1]
    .[F:F].Copy .[L1]
    .[D:E].Copy .[M1]
    .Range("O2:P" & .Rows.Count).Delete xlUp 'RAZ
    With [J1].CurrentRegion
        If .Rows.Count = 1 Then Exit Sub
        .Sort .Cells(1), xlAscending, Header:=xlYes 'tri
       [COLOR=rgb(250, 197, 28)] [/COLOR][COLOR=rgb(251, 160, 38)]For i = .Rows.Count To 2 Step -1
            If .Cells(i, 1) & UCase(.Cells(i, 2)) = .Cells(i - 1, 1) & UCase(.Cells(i - 1, 2)) Then _
                .Cells(i - 1, 3) = .Cells(i - 1, 3) + .Cells(i, 3): .Rows(i).Delete xlUp '_limine les doublons
        Next
        With .Cells(2, 6).Resize(.Rows.Count - 1, 2) 'colonnes O:P
            .Columns(1) = "=VLOOKUP(RC[-5],BDD_Fleurs!C1:C7,7,0)" 'RECHERCHEV
            .Columns(2) = "=RC[-4]*RC[-1]" 'Quantit_ x Prix U.H.T[/COLOR]
[COLOR=rgb(0, 0, 0)]            .Value = .Value 'supprime les formules
            .Borders.Weight = xlThin 'complte les borduress
        End With
    End With
End With
End Sub
[/COLOR]
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas