Aide sur les Formules " liste déroulante"
Bonjour,
Je vous envoie le tableau pour une meilleur compréhension.
J'ai effectuer un tableau excell avec des menus déroulants.
Il me faudrait une formule pour le tableau K25,K27,U1000 etc...
Je m'explique :
Il y a différents onglets (base K25, base K27 etc...) qui correspondent aux différentes informations.
En sélectionnant le menu déroulant tableau K25, je choisis un câble ex: 1 x 35mm2, je voudrais dans la cellule B13 et B14 voir apparaître les longueurs estimative du câble soit (1x35mm2 =2,00 m et 1x35mm2=10,00m) se trouvant dans l'onglet Base K25 .
En colonne C13 et C14 (utilisation) voir apparaître la somme (B13-B14).
Il faudra mettre la même formule pour tous les tableaux en E,F;H,I;K,L; et N,O
J’espère avoir été compris sur le déroulement du tableau.
Merci de votre aide.
Bonjour et bienvenue sur le forum
Un essai à tester. Te convient-il ?
Bye !
Bonjour,
Ça me va très bien. C'est super!!!
Sauf pour les colonnes C,F,I,L, il faudrait enlever le résultat car à la place c'est l'utilisateur qui mettra la quantité utilise - la quantité affiché restante.
Pouvez-vous m'expliquer la fonction car j'aime bien savoir le pourquoi du comment.
Vraiment merci pour votre aide.
Bonjour gmb et nico745...
Intéressant ce probléme, je vais t'expliquer ce que j'ai compris.
Je passe pour la liste déroulante donc.
voici le code avec mes commentaires et question.
Private Sub Worksheet_Change(ByVal Target As Range)
'target.adress est en ligne 11 alors que target est en ligne 8
'les listes déroulantes sont en ligne 11
' on nomme leur cellule dans la feuille
If Target.Address = "$B$11" Or Target.Address = "$E$11" _
Or Target.Address = "$H$11" Or Target.Address = "$K$11" _
Or Target.Address = "$N$11" Then
'on efface les entrées précédentes lignes 13 et 14
If Target = Cells(8, Target.Column) Then
Range(Cells(13, Target.Column), Cells(14, Target.Column + 1)).ClearContents
Exit Sub
End If
'on définit les feuilles f avec les mêmes cellules de la ligne 8 en page accueil)
Set f = Sheets("base " & Cells(8, Target.Column).Value)
'on définit cell comme la variable de recherche de la colonne A de la page concernée.
Set cell = f.Range("A:A").Find(Target.Value)
'"""""""""""""""""""""""""""""""
'çà désactive quoi çà ?
Application.EnableEvents = False
'"""""""""""""""""""""""""""""""
'çà doit vouloir dire que s'il y a qqchose dans la cellule
If Not cell Is Nothing Then
'alors on copie les valeurs en col B sur 2 rangs
f.Range("B" & cell.Row & ":B" & cell.Row + 1).Copy
'on colle on copie spécial valeur
Cells(13, Target.Column).PasteSpecial xlPasteValues
'çà je vois pas, mais çà à l'air d'aditionner les 2 valeurs de gauche à tort
'Cells(13, Target.Column).Offset(0, 1).Resize(2, 1) _
' = Cells(13, Target.Column) + Cells(14, Target.Column)
End If
End If
Application.EnableEvents = True
End Subdu coup j'ai résolu ton probléme des quantités en enlevant l'avant derniére ligne
a+
fronck
Bonjour,
Vous êtes au top!!!!!
C'est super compliqué le VBA.
Merci à toutes les personnes de m'avoir aidé.
Bonjour,
Je viens de m'apercevoir une petite erreur dans le code VBA.
Il ne prends pas les colonnes et longueurs sur 3 et 4 lignes voir plus ex: Câbles K27 1 x 25mm2 il y a 8 lignes à prendre.
Il y a plusieurs lignes sur " U1000 1x6mm2,1x35mm2" "K27 1x25mm2,1x50mm2,1x95mm2,12g1.5mm2""K25 3G10mm2,5G16mm2,
Pouvez-vous modifier le code VBA, j'ai essaye de comprendre mais je suis une truffe.
Merci de votre aide.
Salut nico77410, le fil
Modifie ton code comme suit, évite les cellules fusionnées quand tu travailles en VBA
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, debut: i = 12
If Target.Address = "$B$11" Or Target.Address = "$E$11" _
Or Target.Address = "$H$11" Or Target.Address = "$K$11" _
Or Target.Address = "$N$11" Then
'Si valeur = "K25" alors on quitte
If Target = Cells(8, Target.Column) Then Exit Sub
'On efface les plages "B13:B25"
Range(Cells(13, Target.Column), Cells(25, Target.Column + 1)).ClearContents
'On affecte f
Set f = Sheets("base " & Cells(8, Target.Column).Value)
'On travaille sur la plage de cellules "A4:A30"
With f.Range("A4:A30")
'On recherche la valeur de "B11"
Set cell = .Find(Target.Value, LookIn:=xlValues)
'Si on trouve
If Not cell Is Nothing Then
'On note l'adresse de la première cellule trouvée
debut = cell.Address
Do
'On empêche Excel de calculer et de mettre à jour la feuille, pour éviter de revenir dans la sub récursif infini...
Application.EnableEvents = False
'On incrémente un compteur pour passer d'une ligne à l'autre
i = i + 1
'On copie les valeurs trouvées
Cells(i, Target.Column) = f.Range("B" & cell.Row)
'On recherche la prochaine occurence
Set cell = .FindNext(cell)
'Là on remet à jour
Application.EnableEvents = True
'On boucle tant que l'on trouve un résultat et que l'adresse trouvée n'est pas la même que la première
Loop While Not cell Is Nothing And cell.Address <> debut
End If
End With
End If
End SubBonjour,
C'est très bien, par contre quand on clic sur L'ascenseur K27 ou U1000 etc..le résultat ne revient pas à zéro.
Pouvez-vous rectifier?
Ce que vous avez déjà effectuer est très bien.
Merci de votre aide
Salut niko, le fil
J'ai pas tout compris, de quel résultat tu parles...Si c'est les tableaux dans accueil change comme ça.
C'est une manière comme une autre doit y avoir mieux, mais fait à la va vite....
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, debut, c: i = 12
Application.EnableEvents = False
If Target.Address = "$B$11" Or Target.Address = "$E$11" _
Or Target.Address = "$H$11" Or Target.Address = "$K$11" _
Or Target.Address = "$N$11" Then
'Si valeur = "K25" alors on quitte
If Target = Cells(8, Target.Column) Then Exit Sub
'On efface les plages "X13:X25" de tous les tableaux
For Each c In Array("B13:B25", "E13:E25", "H13:H25", "K13:K25", "N13:N25")
Range(c).Value = ""
Next c
'On affecte f
Set f = Sheets("base " & Cells(8, Target.Column).Value)
'On travaille sur la plage de cellules "A4:A30"
With f.Range("A4:A30")
'On recherche la valeur de "B11"
Set cell = .Find(Target.Value, LookIn:=xlValues)
'Si on trouve
If Not cell Is Nothing Then
'On note l'adresse de la première cellule trouvée
debut = cell.Address
Do
'On empêche Excel de calculer et de mettre à jour la feuille, pour éviter de revenir dans la sub récursif infini...
'On incrémente un compteur pour passer d'une ligne à l'autre
i = i + 1
'On copie les valeurs trouvées
Cells(i, Target.Column) = f.Range("B" & cell.Row)
'On recherche la prochaine occurence
Set cell = .FindNext(cell)
'Là on remet à jour
Application.EnableEvents = True
'On boucle tant que l'on trouve un résultat et que l'adresse trouvée n'est pas la même que la première
Loop While Not cell Is Nothing And cell.Address <> debut
End If
End With
End If
Application.EnableEvents = True
End SubBonjour,
Je m'explique.
Quand on clique sur le tableau K25 et l'on choisis le câble 1 x35mm2. On a le résultat qui apparaît.
Très bien.C'est le but du résultat.
Ensuite, on choisis de revenir en position initiale K25, le résultat devrait s’effacer mais les chiffres restent dans la colonne "longueur estimative".
Pouvez vous rectifier le petit défaut
Salut le fil
Oui faut peut-être se creuser la tête un tout petit peu....
Changes ton code comme suit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, debut: i = 12
'On empêche Excel de calculer et de mettre à jour la feuille, pour éviter de revenir dans la sub récursif infini...
Application.EnableEvents = False
If Target.Address = "$B$11" Or Target.Address = "$E$11" _
Or Target.Address = "$H$11" Or Target.Address = "$K$11" _
Or Target.Address = "$N$11" Then
'Si valeur = "K25" alors on quitte
If Target = Cells(8, Target.Column) Then Target.Offset(2, 0).Resize(13).Value = "": Exit Sub
'On efface les plages "B13:B25"
Range(Cells(13, Target.Column), Cells(25, Target.Column + 1)).ClearContents
'On affecte f
Set f = Sheets("base " & Cells(8, Target.Column).Value)
'On travaille sur la plage de cellules "A4:A30"
With f.Range("A4:A30")
'On recherche la valeur de "B11"
Set cell = .Find(Target.Value, LookIn:=xlValues)
'Si on trouve
If Not cell Is Nothing Then
'On note l'adresse de la première cellule trouvée
debut = cell.Address
Do
'On incrémente un compteur pour passer d'une ligne à l'autre
i = i + 1
'On copie les valeurs trouvées
Cells(i, Target.Column) = f.Range("B" & cell.Row)
'On recherche la prochaine occurence
Set cell = .FindNext(cell)
'On boucle tant que l'on trouve un résultat et que l'adresse trouvée n'est pas la même que la première
Loop While Not cell Is Nothing And cell.Address <> debut
End If
End With
End If
'Là on remet à jour
Application.EnableEvents = True
End SubBonjour,
Par contre, peux-t-on faire une formule pour supprimer la quantité prise par une personne.
Je m' explique :
Je veux prendre une longueur estimative
- K25 5G6mm2 long: 4M si possible faire la soustraction dans la case UTILISATION
Longueur estimative= 4 utilisation : 4 restant 0 mètre.
J'ai voulu supprimer dans l'onglet K25 5G6mm2 = 4,00m et tout le paramétrage ne fonctionne plus.
Pouvez-vous modifier la formule.
J’espère vous avoir bien expliqué