Rechercher une valeur dans une feuille et appliquer la date

Le 13/12/2016 à 16:20

Bonjour à tous, et merci à ceux qui prennent le temps de nous aider

Voilà, je coince sur un bout de code VBA.

J'ai une macro, mais je bloque sur une partie de code

En effet, je souhaite que lorsque je saisie un code dans ma feuille saisie en colonne A, je voudrais pouvoir renvoyer la date dans une autre feuille Paquetage en colonne J lorsque le même code est rencontré dans la colonne E

Je m'explique :

J'ai donc une feuille de mon classeur nommée "Saisie"

Je saisie un code article en colonne A

Suite à cette saisie, je souhaite que dans mon autre feuille nommée "Paquetages", automatiser une recherche dans la colonne E (ou il y a le même code) et que lorsque cette référence est trouvée dans la colonne E, appliquer la date à la même ligne en colonne J

J'ai donc cette partie de macro ou je calle :

With Sheets("Paquetages")

If Application.CountIf(.Columns("E"), Code) <> "" Then

Target.NumberFormat = "00"" ""00"" ""00"" ""00"

.Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date

Ci-dessous, la macro complète de ma feuille saisie :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Dim t As Integer

Dim Article As String

Dim Noms As String

Dim Afficher_Article As String

Dim Code As String

Dim Cel As Range

Article = "=Vlookup(A:A,base!A2:C65000,2,0)"

Afficher_Article = Article

Noms = "=Vlookup(A:A,base!A2:C65000,3,0)"

Code = Target.Offset(0, 0).Value

If Target.Count > 1 Then Exit Sub

''''''''''''''''' Rechercher l'article et le non de l'agent

If Not Intersect(Target, Range("A3:A65000")) Is Nothing Then

If Target = "" Then Exit Sub

Target.NumberFormat = "00"" ""00"" ""00"" ""00"

Target.Offset(0, 1).Formula = "=Vlookup(A:A,base!A2:C65000,2,0)"

Target.Offset(0, 1).Value = Target.Offset(0, 1).Value

Target.Offset(0, 2).Formula = "=Vlookup(A:A,base!A2:C65000,3,0)"

Target.Offset(0, 2).Value = Target.Offset(0, 2).Value

Target.Offset(0, 3) = Date

With Sheets("Suivi des lavages")

If Application.CountIf(.Columns("A"), Target) <> "" Then

Target.NumberFormat = "00"" ""00"" ""00"" ""00"

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Target

.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Afficher_Article

.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = Noms

.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date

.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Year(Now())

.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Value = Month(Now())

With Sheets("Paquetages")

If Application.CountIf(.Columns("E"), Code) <> "" Then

Target.NumberFormat = "00"" ""00"" ""00"" ""00"

.Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date

With Sheets("base")

If Application.CountIf(.Columns("A"), Target) = 0 Then

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Target

MsgBox "Nouveau code barre" & vbCr & "Veuillez compléter la base"

End If

End With

End If

End With

End If

End With

End If

End Sub

Je vous remercie de votre aide

bien cordialement,

TitRominet

Le 13/12/2016 à 17:35

Bonjour,

Utilises les balises Code (bouton Code) pour coller ton code (coller le code entre les balises de début et de fin)

J'ai retouché ton code car je doute que tu ai eu un seul résultat et comme tu as mis un gestionnaire d'erreur, ça ta évité tous les bugs

Je n'ai rien testé, je t'en laisse le soin. J'ai mis quelques commentaires pour que tu comprennes mieux :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim FeLav As Worksheet
    Dim FePack As Worksheet
    Dim FeBase As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Lgn As Long
    Dim Formule1 As String
    Dim Formule2 As String
    Dim Code As String

    If Target.Count > 1 Or Target.Value = "" Then Exit Sub
    If Intersect(Target, Range("A3:A65000")) Is Nothing Then Exit Sub

    Set FeLav = Worksheets("Suivi des lavages")
    Set FePack = Worksheets("Paquetages")
    Set FeBase = Worksheets("base")

    Formule1 = "=Vlookup(A:A,base!A2:C65000,2,0)"
    Formule2 = "=Vlookup(A:A,base!A2:C65000,3,0)"

    Target.NumberFormat = "00"" ""00"" ""00"" ""00"
    Code = Target.Value

    'comme des valeurs sont saisies dans les cellules (lignes de code ci-dessous !) bloque les procédures évènementielles
    Application.EnableEvents = False

    ''''''''''''''''' Rechercher l'article et le non de l'agent
    Target.Offset(, 1).Formula = Formule1
    Target.Offset(, 1).Value = Target.Offset(0, 1).Value
    Target.Offset(, 2).Formula = Formule2
    Target.Offset(, 2).Value = Target.Offset(0, 2).Value
    Target.Offset(, 3).Value = Date

    With FeLav

        If Application.CountIf(.Columns("A"), Code) <> 0 Then

            'sur colonne A avec + 1 pour le décalage vers les cellules vides de dessous
            Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

            .Range("A" & Lgn).Value = Code
            .Range("B" & Lgn).Formula = Formule1
            .Range("C" & Lgn).Formula = Formule2
            .Range("D" & Lgn).Value = Date
            .Range("E" & Lgn).Value = Year(Now())
            .Range("F" & Lgn).Value = Month(Now())

        End If

    End With

    'défini la plage de recherche en colonne E
    With FePack: Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)): End With

    'effectue la recherche...
    Set Cel = Plage.Find(Code, , xlValues, xlWhole)

    'si trouver, entre la date en colonne J
    If Not Cel Is Nothing Then Cel.Offset(, 5).Value = Date

    With FeBase

        If Application.CountIf(.Columns("A"), Code) = 0 Then

            'sur colonne A avec + 1 pour le décalage vers les cellules vides de dessous
            Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

            .Range("A" & Lgn).Value = Code
            MsgBox "Nouveau code barre" & vbCr & "Veuillez compléter la base !"

        End If

    End With

    Application.EnableEvents = True 'rétabli

End Sub
Le 13/12/2016 à 19:47

Theze bonjour et merci de t'être intéressé à ma sollicitation,

J'ai testé la macro, elle ne fonctionne pas tout a fait sur tout les enchainements, mais je ne me suis sans doute pas bien expliqué.

En effet, ta macro exécute :

bien les attentes dans la feuille "saisie"

bien les attentes dans la feuille "Suivi des lavages" mais à condition que le code existe déjà dans cette feuille alors que j'ai besoin d'ajouter chaque codes à la suite

Pas le retour de date dans la feuille "Paquetages"

En faite, j'ai un classeur avec plusieurs feuilles et en fonction des saisies dans la feuille "Saisie" en colonne A, met à jour la feuille "Saisie" et renvoi des valeurs dans d'autres feuilles : "Suivi des lavages" ; "Paquetages"

Donc, j'ai les feuilles suivantes :

"Saisie" qui me sert à y saisir les vêtements qui partent au lavage chez un prestataire

"Base" ou existe toute la base des Articles codifié par un code barre

"Suivi des lavages" ou vient s'y ajouter chaque article saisie dans la feuille "Saisie"

"Paquetages" qui est une base ou sont saisies tous les vêtements remis a des remplaçants

Chaque feuille à sont utilité, je peux développer plus mais cela risque d'encombrer pour pas grand intérêt.

Donc, ce que j'ai besoin, c'est que lorsque un vêtement part au lavage, c'est de mettre à jour mon "suivi des lavages" en enrichissant cette base, chaque article saisie dans la feuille saisie, vient s'y ajouter,

Puis, puisque le vêtement part au lavage, c'est qu'il a été redu par l'agent et donc appliquer la date de restitution dans la feuille "paquetages"

Le déroulement des actions est le suivant,

feuille "saisie"

Je saisie en colonne A le code barre

S'affiche même ligne en colonne B le type d'article par une recherche du genre : "=Vlookup(A:A,base!A2:C65000,2,0)"

S'affiche même ligne en colonne C le nom de l'agent par une recherche du genre : =Vlookup(A:A,base!A2:C65000,3,0)"

S'affiche même ligne en colonne D la date

+

Mise à jour de la feuille "Suivi des lavages"

Vient s'ajouter en colonne A, le code barre

S'affiche même ligne en colonne B le type d'article par une recherche du genre : "=Vlookup(A:A,base!A2:C65000,2,0)"

S'affiche même ligne en colonne C le nom de l'agent par une recherche du genre : =Vlookup(A:A,base!A2:C65000,3,0)"

S'affiche même ligne en colonne D la date

S'affiche même ligne en colonne E l'Année

S'affiche même ligne en colonne F le mois

+

Mise à jour de la feuille "Paquetages"

Recherche le code dans la colonne E et si le trouve pas abandonne, si le trouve, affiche même ligne la date en colonne J

Ma macro permettait cet enchainement, mais je calle sur la dernière action de mise à jour :

Mise à jour de la feuille "Paquetages"

Recherche le code dans la colonne E, si le trouve pas abandonne, si le trouve, affiche même ligne la date en colonne J

Difficile, je cherche, mais je sais que je vais y arriver à un moment ou l'autre, mais j'irai beaucoup plus vite si quelqu'un de plus doué que moi peut me donner un coup de main

PS/ Je peux joindre le fichier si nécessaire .... Y pas de secret

Merci encore,

Cordialement,

TitiRominet

Le 14/12/2016 à 06:55

Bonjour,

Ma macro permettait cet enchainement, mais je calle sur la dernière action de mise à jour :

Mise à jour de la feuille "Paquetages"

Recherche le code dans la colonne E, si le trouve pas abandonne, si le trouve, affiche même ligne la date en colonne J

C'est ce que fait cette portion de code (mis à part l'abandon, rajouté dans le code plus bas) :

'défini la plage de recherche en colonne E
With FePack: Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)): End With

'effectue la recherche...
Set Cel = Plage.Find(Code, , xlValues, xlWhole)

'si trouver, entre la date en colonne J
If Not Cel Is Nothing Then Cel.Offset(, 5).Value = Date

Avec abandon par sortie de la sub :

'défini la plage de recherche en colonne E
With FePack: Set Plage = .Range(.Cells(1, 5), .Cells(.Rows.Count, 5).End(xlUp)): End With

'effectue la recherche...
Set Cel = Plage.Find(Code, , xlValues, xlWhole)

'si trouver, entre la date en colonne J sinon, fin de procédure
If Not Cel Is Nothing Then Cel.Offset(, 5).Value = Date Else Exit Sub
Rechercher des sujets similaires à "rechercher valeur feuille appliquer date"