Remplissage auto mini maxi en Vba

Version imprimable

02/02/2019, 08h52
xxmedxx

Remplissage auto mini maxi en Vba

Salut, je pose mon problème : j'ai une feuille de calcul excel dont (B5 contient une liste de poids 100gr;250gr;500gr;1000gr) , (F4 contient une liste de produit (amande;pistache;noix;...)
i5 = min pesée
J5 = max pesée
dans une deuxième feuille j'ai mis les valeurs min et max de chaque produit
je veux que min et max dans I5 et J5 seront remplies automatiquement par ex : si B5= 100 gr et F4= pistache i5=B10<feuille2>
un grand merci d'avance
02/02/2019, 09h04
anasecu

Bonjour,

Je crois que tu devrais nous expliquer différemment ton problème car ce n'est pas clair.

Dans une cellule tu n'as pas une liste par exemple...
04/02/2019, 09h07
Menhir

Si dans ta liste est écris "100 gr", il sera très compliqué de faire des opérations arithmétiques (comme le calcul du min et du max).
Il serait mieux de rentrer dans la colonne uniquement la valeur numérique et de faire apparaitre l'unité par le format de nombre (Personnalisé > Standard" gr").
Ceci fait, une simple fonction MAX() ou MIN ferait l'affaire.

1 pièce(s) jointe(s)

Bonjour HAMMA, La forum
une proposition si j'ai compris la demande

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$F$4" Then Exit Sub
Dim Tablo
Dim i As Long
Tablo = Sheets("Feuil2").Range("A2", "C" & Sheets("feuil2").Range("C" & Rows.Count).End(xlUp).Row)
With Sheets("feuil1")
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If IsNumeric(Application.Match(CStr(Tablo(i, 1)), .Cells(4, 6), 0)) Then
        .Cells(5, "I") = Tablo(i, 2)
        .Cells(5, "J") = Tablo(i, 3)
    End If
Next i
End With
End Sub

06/02/2019, 16h08
xxmedxx

merci

est ce que je peux joindre mon fichier pour que tu m'aide?
06/02/2019, 16h17
BENNASR

avec quelques ligne de données...pas un grand fichier
09/02/2019, 09h03
xxmedxx

1 pièce(s) jointe(s)

Bonjour Ben Nasr

Désolé pour le retard j'ai pas eu les valeurs qu'aujourd'hui voila mon fichier, un grand merci d'avance :
les valeurs en feuille 2
09/02/2019, 15h28
patricktoulon

re

re
en i5 je met

Citation:

=SI(Tableau4[[#Cette ligne];[Colonne2]]<>"";RECHERCHEV(Tableau4[[#Cette ligne];[Colonne2]];Feuil2!A1:C15;2);"")

en j5 je met

Citation:

=SI(Tableau4[[#Cette ligne];[Colonne2]]<>"";RECHERCHEV(Tableau4[[#Cette ligne];[Colonne2]];Feuil2!A1:C15;3);"")

formule a etirer sur toute les ligne jusqu"a la ligne que tu veux
09/02/2019, 19h41
OrDonc

de l'intérêt des Tableaux (structurés)...

Bonsoir,

en créant le tableau Tb de titres de colonne Produit, Min, Max dans l'autre feuille (ou pas),
les formules en colonne 1 et 2 du tableau des mimi et max à trouver seront

Citation:

=SI(To[@Colonne2]="";"";RECHERCHEV(To[@Colonne2];Tb;2))
=SI(To[@Colonne2]="";"";RECHERCHEV(To[@Colonne2];Tb;3))

nota :
- le premier premier tableau ne se nomme plus Tableau4 mais To
- le tableau Tb est trié selon les produits
- avec le Tableau,les formules s'écrivent automatiquement en cas d'ajout de lignes, se corrigent en cas de suppression de lignes …
- on peut, aussi, déplacer les tableaux sans avoir à modifier les formules.
09/02/2019, 21h50
patricktoulon

re

re
oui ordonc convertir la feuille 2 en tableau simplifie les formules le principe est le meme
et en effet cela permet d'ajouter ou supprimer des ligne dans le tableau structuré de la feuille 2 et les precedents dans les formules suivront
bien vu donc ;) heu...ordonc

1 pièce(s) jointe(s)

re,

Citation:

Envoyé par patricktoulon

bien vu donc :wink: heu...ordonc

et d'un seul oeil :mouarf:!
Puisque VBA demandé, pour un traitement possible avec le tableau To remanié, le tableau MM des cellules ciblées et le tableau Tb des données (déplacé ou pas) :
Un contrôle ActiveX ComboBox nommé Cb (largeur , hauteur et emplacement colonne définis à la création) et
2 macros dans la fenêtre de codes de la feuille (Alt F11)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
'initialisation position,affichage  de la liste
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If Not Intersect(R, [To].Columns(2)) Is Nothing And R.Count = 1 Then
     Cb.List = [Tb].Columns(1).Value     'initialisation de la liste
     Cb.Top = R.Top                      'au niveau de la cellule
     Cb.Visible = 1                      'affichée
  End If
End Sub
'sélection d'un item
Private Sub Cb_Change()       
Dim Lo As Long, C As Range
  Lo = ActiveCell.Row - [To].Row + 1 'ligne active du tableau To(pas de la feuille)  
  Set C = [Tb].Find(Cb, lookAt:=1)
 'traitement de la cellule source et des cellules cibles
  If MsgBox("inclure le choix ?", vbYesNo, "la cellule n'est pas vide...") = 6 Then
    'inclure le nom et les nombres
    ActiveCell = Cb: [MM].Item(Lo, 1) = C(1, 2): [MM].Item(Lo, 2) = C(1, 3)
  Else
    'garder ou vider la cellule source et les cellules correspondantes
    If MsgBox("garder le contenu ?", vbYesNo, "Cellule non vide...") = 7 Then
      'vider pour oui
      ActiveCell = "": [MM].Item(Lo, 1) = "":  [MM].Item(Lo, 2) = ""
    End If
  End If
  Cb.Visible = 0
End Sub

1 pièce(s) jointe(s)

bonjour
je recommande de bien lire les propositions de Patrick :king:et OrDonc :applo: (Bon travail m'a permis d'apprendre bq de chose merci )
Ma proposition qualifiée de DEBUTANT "E"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$5" Then Exit Sub
Dim Plage As Range
With Sheets("feuil2")
Set Plage = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
C = WorksheetFunction.CountIf(Plage, Cells(5, 2))
If C = 0 Then
MsgBox ("Article choisi n'existe pas dans la liste des Min & Max ")
Cells(5, "I") = ""
Cells(5, "J") = ""
Else
Dim i As Long
Tablo = Sheets("Feuil2").Range("A2", "C" & Sheets("feuil2").Range("C" & Rows.Count).End(xlUp).Row)
With Sheets("feuil1")
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If IsNumeric(Application.Match(CStr(Tablo(i, 1)), .Cells(5, 2), 0)) Then
        .Cells(5, "I") = Tablo(i, 2)
        .Cells(5, "J") = Tablo(i, 3)
    End If
Next i
End With
End If
End Sub

11/02/2019, 09h21
xxmedxx

merci pour vos réponse

merci infiniment, une autre question svp :
je voulais que les cellules de B9 - K14 seront diminuer automatiquement de 100
ex si B9 = 500 elle n'affiche que 400

pour être clair je travaille avec une balance et je dois tarer les valeurs avec excel
valeur - poids de l'emballage = valeur exacte du contenu
11/02/2019, 09h34
patricktoulon

re

re
Bonjour
on t'a donné une solution ; mais on va pas faire tout ton travail il sagirait d'aller chercher des tutos ou faq et d'apprendre c'est toi l'etudiant
tu pourrais au moins essayer de faire ta formule a la main en enregistrant la macro et regarder ce que donne la formule dans le code ou meme dans la cellule
tu en apprendrais beaucoup
montre nous un peu plus d'effort et on t'aidera