Macro VBA pour rechercheV

P

Pookie

XLDnaute Nouveau
Bonjour,

Je suis actuellement en galère sur un dossier.
Je vous explique, j'aimerais que:
- dans la feuille "Exemple (2)",en C4, j'écris un code produit (ex: 1151 ou 1597 ou...)
- quand C4 est remplie, alors la macro va chercher le code produit dans la table de la feuille "Table_recette"
- puis elle écrit chaque article qu'elle trouve dans une cellule de la feuille "Exemple (2)" dans D50:H50
- ensuite, si D50 est rempli, elle lit le début du mot (ex: PAI*****) et affecte une couleur de remplissage à cette cellule ainsi qu'à celle du dessous (qui est vide).
- enfin, elle va chercher la valeur (quantité) de l'article (ex: PAI05100=0.012) et la copie dans la cellule D55 de la feuille "Exemple (2)"

Et ainsi de suite que les autres articles (PDM, LEG, VIA...)

Si quelqu'un peut m'aider ça serait super car ça fait 3 jours que je suis bloqué à cause de ça...

Merci d'avance
Pookie
 

Pièces jointes

  • Exemple pookie.xls
    280 KB · Affichages: 90
  • Exemple pookie.xls
    280 KB · Affichages: 96
  • Exemple pookie.xls
    280 KB · Affichages: 91
Trier par date Trier par votes
vmax01

vmax01

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

bonjour Pookie et bonjour le forum

petit code a placer avec un bouton

Code: 
Sub ChercheValeur()
Dim Derligne As Integer
Dim i As Integer
Dim J As Integer
Dim Cell As Range
With Sheets("Exemple (2)").Range(Cells(15, 4), Cells(17, [D15].End(xlToRight).Column))
    .ClearContents
    .Interior.ColorIndex = 2
End With
    If Sheets("Exemple (2)").Range("C4") = "" Then
        Exit Sub
    Else
        For Each Cell In Sheets("Table_recette").Range("B2:B" & Sheets("Table_recette").[B65000].End(xlUp).Row)
            If Cell = Sheets("Exemple (2)").Range("C4") Then
                Cells(15, 4 + J) = Sheets("Table_recette").Cells(i + 2, 1)
                Cells(15, 4 + J).Interior.ColorIndex = 3 + J
                Cells(16, 4 + J).Interior.ColorIndex = 3 + J
                Cells(17, 4 + J) = Sheets("Table_recette").Cells(i + 2, 4)
                J = J + 1
            Else
            End If
            i = i + 1
        Next
    End If
End Sub


bon c'est pas un code de pro mais c'est un début alors comme la lignes 50 etait trop loins ça commence en fait en D15. petit problème de code je l'ai remis donc le dernier est le bon.

bonne soirée.
 
Dernière édition:
Vote positif 0 Vote négatif
D

dra72

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

Bonjour à tous,

Un code à insérer dans la procédure Worksheet_Change de la feuille Exemple:

Code: 
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim L As Boolean
Dim DerLig As Long

If Target.Address = "$C$4" Then
  With Range("D50:H52")
    .Interior.ColorIndex = xlNone
    .ClearContents
  End With
  Range("D55:H56").ClearContents
  
  If Target.Value = "" Then Exit Sub
  With Worksheets("Table_recette")
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("B2:B" & DerLig)
      Set c = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not c Is Nothing Then
        FirstAddress = c.Address
        I = 0
        Do
          Cells(50, I + 4).Value = c.Offset(0, -1).Value
          Cells(55, I + 4).Value = c.Offset(0, 2).Value
          Set c = .FindNext(c)
          I = I + 1
        Loop While Not c Is Nothing And c.Address <> FirstAddress
        Range("D50:D52").Interior.ColorIndex = 53
        With Range("D50")
          K = 0
          For I = 1 To 4
            L = False
            If .Offset(0, I).Value <> "" Then
              For J = 0 To I - 1
                If Left$(.Offset(0, I).Value, 3) = Left$(.Offset(0, J).Value, 3) Then
                  L = True
                  Range("D50:D52").Offset(0, I).Interior.ColorIndex = Range("D50:D52").Offset(0, J).Interior.ColorIndex
                  Exit For
                End If
              Next
              If Not L Then
                K = K + 1
                Range("D50:D52").Offset(0, I).Interior.ColorIndex = Choose(K, 42, 36, 43, 22)
              End If
            End If
          Next
        End With
      End If
    End With
  End With
End If

Bonne soirée.
 
Vote positif 0 Vote négatif
P

Pookie

XLDnaute Nouveau
Re : Macro VBA pour rechercheV

Bonjour vmax01 et dra72,

Merci beaucoup pour votre réponse rapide!
Je pense que je vais opter pour la réponse de dra72 car je ne souhaite pas avoir de bouton de commande sur ma page.
Par contre, est ce que c'est possible d'avoir que les PAI, SAU, VIA, PDM, BOF, PRE et LEG (et pas les FIL, E, CART...) et dans cet ordre?
De plus est ce que c'est également possible d'avoir une couleur précise pour chaque ingrédient?
- PAI = marron
- SAU = jaune clair
- PDM = bleu turquoise
- BOF = orange "or"
- PRE = violet clair
- LEG = vert citron

Merci d'avance!
 
Vote positif 0 Vote négatif
D

dra72

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

Bonjour,

Avant d'aller plus loin, 2 petites questions me viennent à l'esprit:

1) dans ta feuille Table_recette, quels sont les types d'ingrédients que l'on peut trouver?
D'après ce que tu dis, je pense que l'on a d'autres valeurs que PAI, SAU, VIA, PDM, BOF, PRE et LEG. Donc il faudrait les exclure de la feuille Exemple?

2) Quelle couleur attribuer à VIA?

A+
 
Vote positif 0 Vote négatif
P

Pookie

XLDnaute Nouveau
Re : Macro VBA pour rechercheV

re dra72,

1) Oui il y a d'autres valeurs que PAI, SAU, VIA, PDM, BOF, PRE et LEG, mais elles ne m'intéressent pas. Donc je ne souhaite pas les voir sur ma feuille "Exemple (2)".

2) Oups, j'ai oublié VIA = rose

Merci
 
Vote positif 0 Vote négatif
vmax01

vmax01

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

bonjour pookie, dra72.

tu as eu raison de choisir le code de dra72 c'est mieux que moi.... ceci dit mon code peut etre mis exactement comme celui de dra72 en l'insérant dans la procédure Worksheet_Change (si j'ai fait un bouton c'était juste pour l'exemple).

MESSAGE POUR DRA72 : peux tu m'expliquer a quoi sert le .find ?? il y a bien la touche F1 qui explique m'ai j'ai pas compris grand choses....... si tu pouvai de donner ta version (d'explication).


bonne continuation pour ton projet.
 
Vote positif 0 Vote négatif
D

dra72

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

Bonjour,

Pookie,

Voici ma proposition:

Je ne suis pas sur d'avoir respecté les couleurs que tu désirais. Pas exactement les mêmes libellés en version 2000.

Code: 
Dim I As Integer
Dim J As Integer
Dim K(6) As Integer
Dim Col As Integer
Dim DerLig As Long
Dim X As String
Dim CodeR(6) As String
Dim QuantitéR(6) As String

If Target.Address = "$C$4" Then
  cl = Array(53, 36, 7, 8, 44, 39, 43)
  For I = 0 To 6
    K(I) = -1
  Next
  With Range("D50:H52")
    .Interior.ColorIndex = xlNone
    .ClearContents
  End With
  Range("D55:H56").ClearContents
  
  If Target.Value = "" Then Exit Sub
  With Worksheets("Table_recette")
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("B2:B" & DerLig)
      Set C = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not C Is Nothing Then
        FirstAddress = C.Address
        I = 0
        Do
          X = C.Offset(0, -1).Value
          Select Case Left$(X, 3)
            Case "PAI"
              K(I) = 0
            Case "SAU"
              K(I) = 1
            Case "VIA"
              K(I) = 2
            Case "PDM"
              K(I) = 3
            Case "BOF"
              K(I) = 4
            Case "PRE"
              K(I) = 5
            Case "LEG"
              K(I) = 6
          End Select
          If K(I) > -1 Then
            CodeR(I) = X$
            QuantitéR(I) = C.Offset(0, 2).Value
          End If
          Set C = .FindNext(C)
          I = I + 1
        Loop While Not C Is Nothing And C.Address <> FirstAddress
        Col = 0
        For J = 0 To 6
          For I = 0 To 6
            If K(I) = J Then
              Cells(50, Col + 4).Value = CodeR(I)
              Cells(55, Col + 4).Value = QuantitéR(I)
              Range("D50:D52").Offset(0, Col).Interior.ColorIndex = cl(K(I))
              Col = Col + 1
            End If
          Next
        Next
      End If
    End With
  End With
End If

vmax01:
La méthode Find permet de rechercher la première valeur dans une zone.
Ici on recherche la valeur de la cellule modifiée dans Exemple (2) soit Target.value dans la colonne B de Table_recette. FindNext se charge de trouver les autres occurences. Ce qui correspond en gros à la fonction Rechercher d'Excel.
Tu dois pouvoir trouver plein d'informations utiles sur le net à ce sujet

Bonne journée.
 
Vote positif 0 Vote négatif
P

Pookie

XLDnaute Nouveau
Re : Macro VBA pour rechercheV

Ex : quand je tape 1151 en C4,
Message :
Erreur d'éxecution '9' : L'indice n'appartient pas à la sélection.
Et il surligne : K(I) = 0

Ex: quand je tape 1350 en C4,
Message :
Erreur d'éxecution '9' : L'indice n'appartient pas à la sélection.
Et il surligne :K(I) = 2
 
Vote positif 0 Vote négatif
D

dra72

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

Dans Table_recette, je suppose que tu as rajouté les lignes que tu avais enlevées pour l'exemple.

Combien as-tu de colonnes à compléter dans la feuille Exemple (2)? Dans le fichier exemple, on en a 5 (D à H), mais dans le fichier définitif, combien? (de D à ?)
 
Vote positif 0 Vote négatif
P

Pookie

XLDnaute Nouveau
Re : Macro VBA pour rechercheV

Re,

Dans Table_recette, j'ai 5500 lignes en tout.
Dans la feuille Exemple (2), il me faut autant de colonne que de matière possible, or, je peux pas les regarder une par une... je pense qu'on max il y a 8 matières, donc de D à K ou L pour être sur.
 
Vote positif 0 Vote négatif
D

dra72

XLDnaute Occasionnel
Re : Macro VBA pour rechercheV

Allez, j'en ai prévu jusqu'à 12.

Je pense que ça devrait mieux marcher.

Code: 
Dim I As Integer
Dim J As Integer
Dim K(11) As Integer
Dim Col As Integer
Dim DerLig As Long
Dim X As String
Dim CodeR(11) As String
Dim QuantitéR(11) As String

If Target.Address = "$C$4" Then
  cl = Array(53, 36, 7, 8, 44, 39, 43)
  For I = 0 To 11
    K(I) = -1
  Next
  With Range("D50:O52")
    .Interior.ColorIndex = xlNone
    .ClearContents
  End With
  Range("D55:O56").ClearContents
  
  If Target.Value = "" Then Exit Sub
  With Worksheets("Table_recette")
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    With .Range("B2:B" & DerLig)
      Set C = .Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not C Is Nothing Then
        FirstAddress = C.Address
        I = 0
        Do
          X = C.Offset(0, -1).Value
          Select Case Left$(X, 3)
            Case "PAI"
              K(I) = 0
            Case "SAU"
              K(I) = 1
            Case "VIA"
              K(I) = 2
            Case "PDM"
              K(I) = 3
            Case "BOF"
              K(I) = 4
            Case "PRE"
              K(I) = 5
            Case "LEG"
              K(I) = 6
          End Select
          If K(I) > -1 Then
            CodeR(I) = X$
            QuantitéR(I) = C.Offset(0, 2).Value
          End If
          Set C = .FindNext(C)
          I = I + 1
        Loop While Not C Is Nothing And C.Address <> FirstAddress
        Col = 0
        For J = 0 To 6
          For I = 0 To 11
            If K(I) = J Then
              Cells(50, Col + 4).Value = CodeR(I)
              Cells(55, Col + 4).Value = QuantitéR(I)
              Range("D50:D52").Offset(0, Col).Interior.ColorIndex = cl(K(I))
              Col = Col + 1
            End If
          Next
        Next
      End If
    End With
  End With
End If

Ca devait planter au delà de 7.

A +
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
Microsoft 365 Query et liste déroulante: comment faire pour que ça corresponde
Réponses
9
Affichages
481
chris
chris
L
  • Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
378
DJunqueira
D
P
  • Question
XL 2019 Mise en forme conditionnelle sur plusieurs feuilles
Réponses
6
Affichages
353
JHA
J
K
  • Question
Autres 'Resolu' 'Nettoyer' des lignes par une macro
Réponses
7
Affichages
270
klorane
K
M
  • Question
XL 2021 Macro qui permette d'afficher les feuilles à partir d'une liste déroulante
Réponses
5
Affichages
402
MCO2406
M
S
  • Résolu(e)
Autres Copier-Coller en recherchant une ligne spécifique VBA
Réponses
4
Affichages
339
sambio2
S
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
352
JacquesO
J
B
  • Question
XL 2019 Exportation Feuille PDF VBA
Réponses
2
Affichages
294
kiki29
kiki29
C
  • Question
XL 2016 vba , bug sur une macro lors delete xlup
Réponses
7
Affichages
370
ciocciu
C
G
  • Question
XL 2016 Bug dans Données/Convertir si cellule de la ligne 1 vide ?
Réponses
7
Affichages
284
Guy_M
G

Membres actuellement en ligne

5 membres et 32 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 489
Messages
2 088 854
Membres
103 975
dernier inscrit
denry