XL 2019 comment rendre invisible une partie du menu déroulant et l'actualiser automatiquement.

blancolie

XLDnaute Impliqué
Bonjour le forum,

1 ) J'aimerais qu'on puisse voir dans ma liste déroulantes les noms des plantes associer à leur codage (ex:C-ACCR =ACHILLEA crithmifolia.) . Les noms des plantes doivent juste faciliter le choix. quand le choix est fait, doit juste apparaître en B3 le codage - La liste déroulante est dans l'onglet zone de saisie et va puiser ses infos dans l'onglet pramètres ds le tableau avec l'entête Code.

2 ) Pour actualiser ma liste déroulante, je suis obliger de copier le codage dans l'onglet BBD_Technique et de le coller (coller spéciale "valeurs") dans l'onglet paramètre.
Existe t'il une formule (de préférence) ou en vba pour une actualisation automatique ou que les rajouts se fasse automatiquement ?

3 ) faut il utiliser les informations dans paramètre pour la liste déroulante ou peut-on aller piocher les infos dans l'onglet BDD_Technique en colonne A ? faut créer une cellule blanche en A3. Dans ce cas la, le point 2 disparait.

Cordialement
 

Pièces jointes

  • Demande de Devis.xlsm
    64.6 KB · Affichages: 27

fanch55

XLDnaute Barbatruc
Pb Excel, pas de téléchargement .
Cela m'arrive assez souvent qu'Excel veuille corriger un fichier soit disant incorrect .
La correction est toujours destructrice ...
Cela dénote une instabilité d'Office pour la session en cours .
Je re-démarre Windows et là, miracle, le fichier s'ouvre correctement ( c'est ch... ) . :mad:

Sinon je vous joint le fichier de Sylvanu mais sans le VB et en Xlsx ( les formules devraient s'afficher correctement , pas besoin du Vb).

Au fait c'est bien Excel 2019 que vous utilisez ?
 

Pièces jointes

  • Demande de Devis 2.xlsx
    56.4 KB · Affichages: 6

blancolie

XLDnaute Impliqué
je viens de passer sur 365 sur mac mais c'est l'équivalent d excel 2019 . la différence cest qu'il n y a pas de validation à faire, on obtient les nouvelles fonctions comme recherche X .
j'ouvrais les fichiers de sylvanu en avec 2019
 

blancolie

XLDnaute Impliqué
j'ai uniquement un seul mac chez moi, j'utilisais toujours 365 en payant un abonnement mais pendant 1 semaine , je suis passée sur 2019.

j'ai essaye d'ouvrir le fichier sur pc sur mon lieu de travail avec une version antérieure de 2019, faut que je verifie réellement et cela me donnait le même résultat.

jamais eu de soucis de comptabilité de formule.

j'arrrive à lire ton fichier sans aucun problème.

dommage que je ne puisse pas voir la macro sauf si tu me la copie
 

fanch55

XLDnaute Barbatruc
Il n'y a aucune macro supplémentaire .
Sylvanu a tout fait brillamment par Formule .
Cliquez sur une cellule dans Zone de Saisie, colonne Plantes, et choisissez parmi la liste, cela devrait fonctionner et mettre à jour toute la ligne ...

Par curiosité, tous les fichiers que vous a envoyé Sylvanu posent le même problème ?
Au fait, @sylvanu, merci ;), je ne savais pas qu'on pouvait mettre une fonction dans une liste de validation ( expérience + 1 )
 

blancolie

XLDnaute Impliqué
oui tout les fichiers, mais ce qui est drole c'est que tu me dis qu'il n y a pas de macro ? moi on me demande d'activer les macros lors de l'ouverture du fichier et de plus, il me semble que son premier post à sylvanu parlait de macro léger
 

fanch55

XLDnaute Barbatruc
Bizarre, aucune macro dans un fichier *.xlsx .
Vous pouvez le vérifier en entrant dans le VBE, normalement, y'a plus rien ....

Il suffit de cliquer sur une des zones sous la colonne Plante de la feuille de Saisie et toute la ligne s'ajuste .

Je vous joins le fichier entier (Xlsb) de Sylvanu, des fois que ... mais je n'y crois pas trop ...
 

Pièces jointes

  • Sylvanu by Fanch55.xlsb
    54.7 KB · Affichages: 5

fanch55

XLDnaute Barbatruc
Complétez ses formules par ce que j'ai suggéré un peu plus haut ,
cela évitera de modifier toutes les formules en cas de déplacement des colonnes de tables:
VB:
 =SIERREUR(INDEX(T_BDDTECHNIQUE[Code];EQUIV([@Plantes];T_BDDTECHNIQUE[Plantes];0));"")

Par ailleurs, certaines colonnes de la feuille de saisie sont déjà correctes:
Olivier, l'auteur initial avait déjà bien œuvré .

Restent les points 2 et 3
 
Dernière édition:

job75

XLDnaute Barbatruc
Bon on ne va pas faire un fil qui n'en finit pas comme certains aiment le faire...

Je sais que brancolie aura beaucoup de mal à accepter que son travail soit entièrement revu mais je joins tout de même le fichier adapté à la solution du fil précédent :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:E]) Is Nothing Then Exit Sub
Dim critere$, tablo, resu(), i&, n&
Application.EnableEvents = False 'désactive les évènements
If [B2] = "" Then [C2] = "": GoTo 1
If Not Intersect(Target, [B2]) Is Nothing Then [C2] = ""
critere = LCase([B2] & Chr(1) & "*" & CStr([C2])) & "*"
tablo = Sheets("BDD_Technique").[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 6)
For i = 2 To UBound(tablo)
    If LCase(tablo(i, 3) & Chr(1) & tablo(i, 1)) Like critere Then
        n = n + 1
        resu(n, 1) = tablo(i, 3)
        resu(n, 2) = tablo(i, 1)
        resu(n, 3) = tablo(i, 4)
        resu(n, 4) = tablo(i, 5)
    End If
Next
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [B5] '1ère cellule de restitution
     If n Then .Resize(n, 6) = resu
     .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).ClearContents 'RAZ en dessous
End With
Columns(3).AutoFit 'ajustement largeur
ActiveWindow.ScrollRow = 1 'cadrage
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub Transfert()
Dim n&, w As Worksheet
With [A4].CurrentRegion.Resize(, 7)
    n = Application.CountIf(.Columns(6), ">0")
    If [B2] = "" Or n = 0 Then Exit Sub
    If MsgBox("Transférer " & n & " ligne" & IIf(n = 1, " ?", "s ?"), 36, "Transfert vers " & [B2]) = 7 Then Exit Sub
    Application.ScreenUpdating = False
    Set w = Sheets("Devis " & [B2]) 'feuille du fournisseur
    .AutoFilter 6, ">0" 'filtre automatique
    Intersect(Range("C5:G" & Rows.Count), .Cells).Copy w.Cells(w.Rows.Count, 2).End(xlUp)(2) 'copier-coller
    .AutoFilter 'désactive le filtre
End With
w.Columns(2).AutoFit 'ajustement largeur
w.Columns(6).AutoFit 'ajustement largeur
w.Activate
[B2] = "" 'RAZ
End Sub

Sub RAZ()
'---pour les feuilles des devis---
With ActiveSheet
    If .Name Like "Devis*" Then .Range("B3:F" & .Rows.Count).Delete xlUp
End With
End Sub
 

Pièces jointes

  • Demande de Devis(1).xlsm
    54.6 KB · Affichages: 16

Discussions similaires

Statistiques des forums

Discussions
312 338
Messages
2 087 393
Membres
103 537
dernier inscrit
alisafred974