petit probleme msgbox

[patoq]

Bonjour tout le monde
Alors voila mon probleme :
j'ai 2 colonnes (une avec des racks et l'autre avec des codes produits).
J'ai une macro avec une inputbox qui me demande un code produit ,je renseigne ,et il me trouve le rack correspondant en me l'affichant dans une msgbox.

Jusque la tout va bien ,ça marche!!!

Le hic c'est ,que étant donné que des produits identiques peuvent se trouver dans des racks differents ,j'aimerais que le msgbox m'affiche tous les racks trouvés pour un seul code produit. Et la je coince je n'arrive pas a afficher plusieurs résultats sniff sniff
PS : j'aimerais garder mon inputbox tel quelle.

J'espere avoir été clair ,sachant que pour certains ça va etre de la bagatelle

je joint mont fichier pour exemple

 

[Papou-net]

Re : petit probleme msgbox

Bonsoir patoq, et bienvenue à toi,

Tu peux modifier ta macro comme ci-dessous :

Sub Bouton2_Clic()
Dim Message As String
REP = InputBox("Entrez un code produit", "Mon Programme")
If REP = "" Then Exit Sub
For Each cel In Range("B:B").SpecialCells(xlCellTypeConstants)
    If CStr(cel.Value) = REP Then Message = Message & vbCrLf & Cells(cel.Row, 1)
Next
If Message = "" Then
    MsgBox "le code " & REP & " n'a pas été trouvée", vbExclamation, "Mon programme"
    Else
    MsgBox "Emplacement(s) trouvé(s) : " & Message
End If
End Sub

Espérant avoir répondu.

Cordialement.

 

[pierrejean]

Re : petit probleme msgbox

Bonsoir patoq

Vois si cela te convient

Edit: Salut Papou-net

 

[Guest]

Re : petit probleme msgbox

Bonjour,

Je te suggère d'aller voir l'aide excel sur la méthode Find et ses paramètre car en l'état que l'utilisateur mette la référence complète ou partielle (ex 200 pour 31200) les cellules sont trouvées. Risque d'erreur

Sub Bouton2_Clic()
    Dim r As Range, adr As String, texte As String
    REP = InputBox("Entrez un code produit", "Mon Programme")
    If REP = "" Then Exit Sub
    With Sheets("Feuil1").Columns(2)
        Set r = .Find(REP)
        If Not r Is Nothing Then
            adr = r.Address
            Do
                texte = texte & r(1, 0).Value & vbCrLf
                Set r = .FindNext(r)
            Loop While Not r Is Nothing And r.Address <> adr
            MsgBox "Emplacement(s) trouvé(s): " & vbCrLf & texte
        Else
        MsgBox "Emplacement trouvé : " & r.Offset(0, -1).Value
    End If
    End With
End Sub

A+
Hello Papou, Pierre-Jean

 

[patoq]

Re : petit probleme msgbox

C'est merveilleux ça marche je te remercie bcp papou tu me sauve!!!
J'avoue que j'avais codé comme un porc ,je vais déchiffrer ta macro pour en apprendre plus sur mes erreurs

 

[Papou-net]

Re : petit probleme msgbox

Bonsoir pierrejean, Hasco,

Avec ma méthode, seule une occurrence exacte est trouvée.

Cordialement.

 

[patoq]

Re : petit probleme msgbox

Salut Pierre-Jean et Hasco j'ai pas regardé vos fichiers encore je m'empresse de ce pas et je vous retourne mes impressions

Edit 1 : Pierre Jean j'ai regardé j'aime bien la forme du résultat avec les racks espacés

Edit 2 : Je confirme papou ,seul ta formule donne une seule occurence!

Merci encore a vous tous pour vos reponses rapides

 

[patoq]

Re : petit probleme msgbox

je reviens vers vous pour mon dernier petit problème (je sais j'abuse)
C'est un peu l'inverse du precedent
Ici c'est pour libérer un rack ,ma macro marche et libere la ligne ,SAUF si un rack contient plusieurs produits je n'ai pas le choix il libere le premier trouvé
Comment faire pour lui faire choisir en cas de produits multiples sur le meme rack ?
Ci joint un exemple
merci d'avance

 

[Compte Supprimé 979]

Re : petit probleme msgbox

Bonsoir Patoq

Tu peux utiliser ce code

Sub Bouton1_Clic()
  Dim Var As String, Var1 As String
  Dim MotTrouvé
  On Error Resume Next
  Var1 = InputBox("Rack ?", , "zzzz")
  If Var1 = "" Then Exit Sub
  Set MotTrouvé = Range("A4").EntireColumn.Find(What:=Var1, lookat:=xlWhole)
  If Not MotTrouvé Is Nothing Then
    ' Vérifier si existe plusieurs codes identiques
    If Application.WorksheetFunction.CountIf(Range("A:A"), Var1) > 1 Then
      Var = InputBox("Merci de saisir le code ?", "CODE")
      If Var = "" Then Exit Sub
      ' Trouver le code
      Set MotTrouvé = Range("B3").EntireColumn.Find(What:=Var, lookat:=xlWhole)
      ' Si le code a été trouvé et que le rack correspond
      If Not MotTrouvé Is Nothing And MotTrouvé.Offset(0, -1) = Var1 Then
        Style = vbYesNo + vbDefaultButton1
        Msg = "Vider l'emplacemennt => Rack : " & Var1 & " - code produit : " & Var
        Title = "Attention"
        Réponse = MsgBox(Msg, Style, Title)
        If Réponse = vbYes Then
          MotTrouvé.EntireRow.Delete Shift:=xlUp
          MsgBox " Le rack est libre maintenant"
        End If
      Else
        MsgBox "Code non trouvé"
      End If
    Else
      Var = MotTrouvé.Offset(0, 1).Value
      Style = vbYesNo + vbDefaultButton1
      Msg = "Vider l'emplacemennt => Rack : " & Var1 & " - code produit : " & Var
      Title = "Attention"
      Réponse = MsgBox(Msg, Style, Title)
      If Réponse = vbYes Then
        MotTrouvé.EntireRow.Delete Shift:=xlUp
        MsgBox " Le rack est libre maintenant"
      End If
    End If
  Else
    MsgBox "Rien trouvé", vbExclamation, "Mon programme"
    Exit Sub
  End If
  [A1].Select
End Sub

A+

 

[patoq]

Re : petit probleme msgbox

que dire de plus ,c'est la grande classe ,waouhhh ça fonctionne à merveille!!
Et moi qui cherchait depuis des heures, j'en ai des choses à apprendre
Merci Bruno tu est vraiment un sacré Barbatruc

 

[Papou-net]

Re : petit probleme msgbox

J'ai été interrompu par le dîner, mais puisque je viens de le terminer je te l'envoie.

Toutefois, je pense qu'il serait plus ergonomique de passer par un UserForm avec des listes déroulantes.

Cordialement.

 

[patoq]

Re : petit probleme msgbox

Deux approches différentes mais les 2 fonctionnent a merveille ,merci papou.
Concernant un Userform, pourquoi pas ,je vais essayer mais juste en cas de produits multiples sur un rack
Bonne idée, si je galere je sais ou venir

 

[Papou-net]

Re : petit probleme msgbox

Deux approches différentes mais les 2 fonctionnent a merveille ,merci papou.
Concernant un Userform, pourquoi pas ,je vais essayer mais juste en cas de produits multiples sur un rack
Bonne idée, si je galere je sais ou venir

Bonjour patoq,

Comme j'avais commencé ce projet, je le termine et te l'envoie pour le cas où il te serait utile.

Bonne journée.

Cordialement.

 

[patoq]

Re : petit probleme msgbox

Bonjour papou
je viens de le voir, c'est terrible et vachement plus ergonomique que ce que j'ai fais.
Merci Papou-net je savais qu'il y avait des cadors ici!!

 

[patoq]

Re : petit probleme msgbox

re tout le monde
Sur le classeur patoq2 de papou, je dois etre un peu gogole j'arrive pas a modifier pour pouvoir supprimer que la valeur du code produit (et pourtant j'ai essayé plein de trucs) .
En fait il ne faudrait pas supprimer la ligne entiere ,car la je supprime le rack alors que je ne veut que le vider .
J'aimerais juste avoir la cellule vide pour ajouter de nouveaux produits par la suite.
Merci d'avance.