Copier ligne et modifier
Bonjour, alors voila
pour le 1er onglet: jaimerais avoir un menu déroulant avec les différents aliments de l'onglet "aliment", sa je sais le faire avec la validation de données.
j'aimerais qu'un fois sélectionner, toute la ligne de cette aliment se recopie sur mon premier onglet, et jaimerais ensuite pouvoir modifier le chiffre de la colonne "quantité" et que mes 4 dernieres colonnes puisse se modifier en fonction de la quantité que jai choisi de mettre. le calcul sera comme un ratio. si jai 100g de boeuf haché.... les macros sont de 223-31-0-11 mais si je change ma qte a 200gr.... j'ai besoin que les macros change pour 446-62-0-22
Je suis capable de tout faire sa manuelle avec des formules, mais sa manque d'automatiste un peu..... pouvez-vous m'aider ?
Bonjour,
A tester.
Voici le code (désolé, je suis embrumé ce matin, je n'arrive pas à meilleur... ça arrive!)
Private Const INGREDIENTS As String = "$B$9:$B$14,$B$16:$B$21,$B$23:$B$28,$B$30:$B$35,$B$37:$B$42"
Private Const QUANTITE As String = "$C$9:$C$14,$C$16:$C$21,$C$23:$C$28,$C$30:$C$35,$C$37:$C$42"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Integer, rngRech As Range
If Sh.Name <> "Aliments" Then
With Sh
If Target.Cells.Count = 1 Then
If Not Intersect(Target, .Range(INGREDIENTS)) Is Nothing Then
Application.EnableEvents = False
If Target.Value <> vbNullString Then
With Worksheets("Aliments")
Set rngRech = .Cells.Find(Target.Value)
End With
If Not rngRech Is Nothing Then
If Target.Offset(0, 1).Value <> vbNullString Then
For i = 4 To 7
Target.Offset(0, i).Value = rngRech.Offset(0, i).Value
Next
Else
For i = 4 To 7
Target.Offset(0, i).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Offset(0, 1).Value
Next
End If
Else
MsgBox "Aliment non trouvé"
.Range("F" & Target.Row & ":L" & Target.Row).ClearContents
End If
Else
.Range("C" & Target.Row & ":L" & Target.Row).ClearContents
End If
Application.EnableEvents = True
ElseIf Not Intersect(Target, .Range(QUANTITE)) Is Nothing Then
Application.EnableEvents = False
If Target.Value <> vbNullString Then
With Worksheets("Aliments")
Set rngRech = .Cells.Find(Target.Offset(0, -1).Value)
End With
If Not rngRech Is Nothing Then
For i = 4 To 7
Target.Offset(0, i - 1).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Value
Next
Else
MsgBox "Aliment non trouvé"
.Range("F" & Target.Row & ":L" & Target.Row).ClearContents
End If
Else
.Range("C" & Target.Row & ":L" & Target.Row).ClearContents
End If
Application.EnableEvents = True
End If
End If
End With
End If
End SubJe t'ai laissé les listes de validation...
Merci !
Mais il y a un bogue... quand je veux rajouter un aliment, rien ne se passe, il ne recopie pas la ligne du tableau dans l'onglet aliment :(
oops désolé, c'est mon ordi qui a eu un bogue lol sa fonctionne ! merci beaucoup
Bonjour,
A tester.
Voici le code (désolé, je suis embrumé ce matin, je n'arrive pas à meilleur... ça arrive!)
Private Const INGREDIENTS As String = "$B$9:$B$14,$B$16:$B$21,$B$23:$B$28,$B$30:$B$35,$B$37:$B$42" Private Const QUANTITE As String = "$C$9:$C$14,$C$16:$C$21,$C$23:$C$28,$C$30:$C$35,$C$37:$C$42" Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim i As Integer, rngRech As Range If Sh.Name <> "Aliments" Then With Sh If Target.Cells.Count = 1 Then If Not Intersect(Target, .Range(INGREDIENTS)) Is Nothing Then Application.EnableEvents = False If Target.Value <> vbNullString Then With Worksheets("Aliments") Set rngRech = .Cells.Find(Target.Value) End With If Not rngRech Is Nothing Then If Target.Offset(0, 1).Value <> vbNullString Then For i = 4 To 7 Target.Offset(0, i).Value = rngRech.Offset(0, i).Value Next Else For i = 4 To 7 Target.Offset(0, i).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Offset(0, 1).Value Next End If Else MsgBox "Aliment non trouvé" .Range("F" & Target.Row & ":L" & Target.Row).ClearContents End If Else .Range("C" & Target.Row & ":L" & Target.Row).ClearContents End If Application.EnableEvents = True ElseIf Not Intersect(Target, .Range(QUANTITE)) Is Nothing Then Application.EnableEvents = False If Target.Value <> vbNullString Then With Worksheets("Aliments") Set rngRech = .Cells.Find(Target.Offset(0, -1).Value) End With If Not rngRech Is Nothing Then For i = 4 To 7 Target.Offset(0, i - 1).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Value Next Else MsgBox "Aliment non trouvé" .Range("F" & Target.Row & ":L" & Target.Row).ClearContents End If Else .Range("C" & Target.Row & ":L" & Target.Row).ClearContents End If Application.EnableEvents = True End If End If End With End If End SubJe t'ai laissé les listes de validation...
tout fonctionne, mais je ne comprend pas pourquoi la ligne des aliment riz brun, ne calcule pas du tout la bonne chose.....le reste tout est bon !
Bonjour,
Exact.
Parce qu'il trouve d'autres riz brun... Par exemple : Pain de riz brun...
Voici le code modifié :
Option Explicit
Private Const INGREDIENTS As String = "$B$9:$B$14,$B$16:$B$21,$B$23:$B$28,$B$30:$B$35,$B$37:$B$42"
Private Const QUANTITE As String = "$C$9:$C$14,$C$16:$C$21,$C$23:$C$28,$C$30:$C$35,$C$37:$C$42"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Integer, rngRech As Range
If Sh.Name <> "Aliments" Then
With Sh
If Target.Cells.Count = 1 Then
If Not Intersect(Target, .Range(INGREDIENTS)) Is Nothing Then
Application.EnableEvents = False
If Target.Value <> vbNullString Then
With Worksheets("Aliments")
Set rngRech = .Cells.Find(Target.Value, lookat:=xlWhole)
End With
If Not rngRech Is Nothing Then
If Target.Offset(0, 1).Value <> vbNullString Then
For i = 4 To 7
Target.Offset(0, i).Value = rngRech.Offset(0, i).Value
Next
Else
For i = 4 To 7
Target.Offset(0, i).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Offset(0, 1).Value
Next
End If
Else
MsgBox "Aliment non trouvé"
.Range("F" & Target.Row & ":L" & Target.Row).ClearContents
End If
Else
.Range("C" & Target.Row & ":L" & Target.Row).ClearContents
End If
Application.EnableEvents = True
ElseIf Not Intersect(Target, .Range(QUANTITE)) Is Nothing Then
Application.EnableEvents = False
If Target.Value <> vbNullString Then
With Worksheets("Aliments")
Set rngRech = .Cells.Find(Target.Offset(0, -1).Value, lookat:=xlWhole)
End With
If Not rngRech Is Nothing Then
For i = 4 To 7
Target.Offset(0, i - 1).Value = rngRech.Offset(0, i).Value / rngRech.Offset(0, 1).Value * Target.Value
Next
Else
MsgBox "Aliment non trouvé"
.Range("F" & Target.Row & ":L" & Target.Row).ClearContents
End If
Else
.Range("C" & Target.Row & ":L" & Target.Row).ClearContents
End If
Application.EnableEvents = True
End If
End If
End With
End If
End Submerci pour ta réponse, c'est super apprécié..... derniere petite question... j'Arrive pas a voir ou tu a mis le code haha... il n'est pas dans les macros, nis dans les cellules....
ou le placer :O ?
encore merci !
Dans le module ThisWorkbook.
Quand tu ouvres VBE, tu as une petite fenêtre en haut à gauche nommée : Projet - VBAProject
Dans cette fenêtre tu as tous les modules et autres feuilles de tous tes classeurs ouverts.
Sélectionne ton classeur et cherche le module ThisWorkbook.