Afficher un chiffre dans une cellule

Le 05/06/2025 à 11:58

Bonjour, j'ai un script qui théoriquement devrait me mettre un chiffre ou une lettre dans les cellules allant de B4:V18 si l'information contenue dans la cellule X2 est identique aux informations qui se trouvent dans les cellules A4:A18 et sur la ligne correspondante mais je n'y arrive pas; un petit coupe de pouce ....Merci :

Private Sub Worksheet_Change(ByVal Target As Range)
' *** PARAMÈTRES À CONFIGURER ***
Const CELLULE_LISTE_DEROULANTE As String = "W2"
Const CELLULE_VALEUR_A_RECHERCHER As String = "X2"
Const PLAGE_CRITERES_RECHERCHE As String = "A4:A18"
Const VALEUR_A_INSCRIRE As Variant = 1
Const COLONNE_SAISIE_DEBUT As String = "B"
Const COLONNE_SAISIE_FIN As String = "V"
' *** FIN DES PARAMÈTRES ***

Dim rngListeDeroulante As Range
Dim rngValeurARechercher As Range
Dim rngCritereTrouve As Range
Dim valeurCherchee As Variant
Dim ligneCorrespondante As Long
Dim plageRechercheLigne As Range
Dim celluleCible As Range
Dim c As Range ' Variable pour la boucle

Set rngListeDeroulante = Me.Range(CELLULE_LISTE_DEROULANTE)
Set rngValeurARechercher = Me.Range(CELLULE_VALEUR_A_RECHERCHER)

If Not Intersect(Target, rngListeDeroulante) Is Nothing Then
Application.EnableEvents = False
Application.Wait Now + TimeValue("00:00:00.001") ' <-- Cette ligne est la preuve que la macro se déclenche

valeurCherchee = rngValeurARechercher.Value

' AJOUTE UN MSGBOX ICI POUR VÉRIFIER LA VALEUR DE X2
MsgBox "Valeur lue dans X2 : '" & valeurCherchee & "'" & _
vbCrLf & "Type de valeur : " & TypeName(valeurCherchee) & _
vbCrLf & "Est vide ? " & IsEmpty(valeurCherchee) & _
vbCrLf & "Est erreur ? " & IsError(valeurCherchee) & _
vbCrLf & "Longueur (si texte) : " & IIf(TypeName(valeurCherchee) = "String", Len(valeurCherchee), "N/A")

If Not IsEmpty(valeurCherchee) And Not IsError(valeurCherchee) Then
' MsgBox "X3 contient une valeur valide, recherche lancée."

Set rngCritereTrouve = Me.Range(PLAGE_CRITERES_RECHERCHE).Find( _
What:=valeurCherchee, _
LookIn:=xlValues, _
LookAt:=xlWhole _
)

' AJOUTE UN MSGBOX ICI POUR VÉRIFIER LE RÉSULTAT DE LA RECHERCHE
If Not rngCritereTrouve Is Nothing Then
MsgBox "Valeur trouvée dans " & PLAGE_CRITERES_RECHERCHE & " à la ligne " & rngCritereTrouve.Row & "."
Else
MsgBox "Valeur '" & valeurCherchee & "' de X2 NON trouvée dans la plage " & PLAGE_CRITERES_RECHERCHE & "."
End If

If Not rngCritereTrouve Is Nothing Then
ligneCorrespondante = rngCritereTrouve.Row

' MsgBox "Ligne correspondante : " & ligneCorrespondante

Set plageRechercheLigne = Me.Range( _
Me.Cells(ligneCorrespondante, Me.Range(COLONNE_SAISIE_DEBUT).Column), _
Me.Cells(ligneCorrespondante, Me.Range(COLONNE_SAISIE_FIN).Column) _
)

Set celluleCible = Nothing
For Each c In plageRechercheLigne
If IsEmpty(c) Or c.Value = "" Then
Set celluleCible = c
Exit For
End If
Next c

If Not celluleCible Is Nothing Then
celluleCible.Value = VALEUR_A_INSCRIRE
MsgBox "Valeur '" & VALEUR_A_INSCRIRE & "' inscrite dans la cellule " & celluleCible.Address & ".", vbInformation
Else
MsgBox "Toutes les colonnes de " & COLONNE_SAISIE_DEBUT & " à " & COLONNE_SAISIE_FIN & " sont déjà remplies pour la ligne " & ligneCorrespondante & ".", vbInformation
End If
Else
' Ce MsgBox est déjà géré par le MsgBox précédent
' MsgBox "La valeur '" & valeurCherchee & "' en " & CELLULE_VALEUR_A_RECHERCHER & " n'a pas été trouvée dans la plage " & PLAGE_CRITERES_RECHERCHE & "." & vbCrLf & _
' "Vérifiez les formats et les espaces cachés.", vbInformation
End If
Else
MsgBox "La cellule " & CELLULE_VALEUR_A_RECHERCHER & " est vide ou contient une erreur. Aucune action n'a été effectuée.", vbInformation
End If

Application.EnableEvents = True
End If
End Sub

Le 05/06/2025 à 16:37

Bonjour,

Quelques erreurs dans le code: ici en particulier:

Set plageRechercheLigne = Me.Range( _
Me.Cells(ligneCorrespondante, Me.Range(COLONNE_SAISIE_DEBUT).Column), _
Me.Cells(ligneCorrespondante, Me.Range(COLONNE_SAISIE_FIN).Column) _
)

code corrigé:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' *** PARAMÈTRES À CONFIGURER ***
    Const CELLULE_LISTE_DEROULANTE As String = "W2"
    Const CELLULE_VALEUR_A_RECHERCHER As String = "X2"
    Const PLAGE_CRITERES_RECHERCHE As String = "A4:A18"
    Const VALEUR_A_INSCRIRE As Variant = 1
    Const COLONNE_SAISIE_DEBUT As String = "B"
    Const COLONNE_SAISIE_FIN As String = "V"
    ' *** FIN DES PARAMÈTRES ***

    Dim rngListeDeroulante As Range
    Dim rngValeurARechercher As Range
    Dim rngCritereTrouve As Range
    Dim valeurCherchee As Variant
    Dim ligneCorrespondante As Long
    Dim plageRechercheLigne As Range
    Dim celluleCible As Range
    Dim c As Range ' Variable pour la boucle

    Set rngListeDeroulante = Me.Range(CELLULE_LISTE_DEROULANTE)
    Set rngValeurARechercher = Me.Range(CELLULE_VALEUR_A_RECHERCHER)
    On Error GoTo Sortie

    If Not Intersect(Target, rngListeDeroulante) Is Nothing Then
        Application.EnableEvents = False
        Application.Wait Now + TimeValue("00:00:01") ' <-- Cette ligne est la preuve que la macro se déclenche
        valeurCherchee = rngValeurARechercher.Value

        ' AJOUTE UN MSGBOX ICI POUR VÉRIFIER LA VALEUR DE X2
        MsgBox "Valeur lue dans X2 : '" & valeurCherchee & "'" & _
        vbCrLf & "Type de valeur : " & TypeName(valeurCherchee) & _
        vbCrLf & "Est vide ? " & IsEmpty(valeurCherchee) & _
        vbCrLf & "Est erreur ? " & IsError(valeurCherchee) & _
        vbCrLf & "Longueur (si texte) : " & IIf(TypeName(valeurCherchee) = "String", Len(valeurCherchee), "N/A")

        If Not IsEmpty(valeurCherchee) And Not IsError(valeurCherchee) Then
            ' MsgBox "X3 contient une valeur valide, recherche lancée."
            Set rngCritereTrouve = Me.Range(PLAGE_CRITERES_RECHERCHE).Find(What:=valeurCherchee, LookIn:=xlValues, LookAt:=xlWhole)

            ' AJOUTE UN MSGBOX ICI POUR VÉRIFIER LE RÉSULTAT DE LA RECHERCHE
            If Not rngCritereTrouve Is Nothing Then
                MsgBox "Valeur trouvée dans " & PLAGE_CRITERES_RECHERCHE & " à la ligne " & rngCritereTrouve.Row & "."
            Else
                MsgBox "Valeur '" & valeurCherchee & "' de X2 NON trouvée dans la plage " & PLAGE_CRITERES_RECHERCHE & "."
            End If

            If Not rngCritereTrouve Is Nothing Then
                ligneCorrespondante = rngCritereTrouve.Row
                ' MsgBox "Ligne correspondante : " & ligneCorrespondante
                Set plageRechercheLigne = Me.Range(Me.Cells(ligneCorrespondante, COLONNE_SAISIE_DEBUT), Me.Cells(ligneCorrespondante, COLONNE_SAISIE_FIN))

                Set celluleCible = Nothing
                For Each c In plageRechercheLigne
                    If IsEmpty(c) Or c.Value = "" Then
                        Set celluleCible = c
                        Exit For
                    End If
                Next c

                If Not celluleCible Is Nothing Then
                    celluleCible.Value = VALEUR_A_INSCRIRE
                    MsgBox "Valeur '" & VALEUR_A_INSCRIRE & "' inscrite dans la cellule " & celluleCible.Address & ".", vbInformation
                Else
                    MsgBox "Toutes les colonnes de " & COLONNE_SAISIE_DEBUT & " à " & COLONNE_SAISIE_FIN & " sont déjà remplies pour la ligne " & ligneCorrespondante & ".", vbInformation
                End If
            Else
                ' Ce MsgBox est déjà géré par le MsgBox précédent
                ' MsgBox "La valeur '" & valeurCherchee & "' en " & CELLULE_VALEUR_A_RECHERCHER & " n'a pas été trouvée dans la plage " & PLAGE_CRITERES_RECHERCHE & "." & vbCrLf & _
                ' "Vérifiez les formats et les espaces cachés.", vbInformation
                End If
            Else
               MsgBox "La cellule " & CELLULE_VALEUR_A_RECHERCHER & " est vide ou contient une erreur. Aucune action n'a été effectuée.", vbInformation
            End If
Sortie:
        Application.EnableEvents = True
    End If
End Sub

Cdlt

Le 05/06/2025 à 17:20

OK, merci beaucoup; je vais voir de mettre ça à jour.

Bonne fin de journée.

Cordialement

Rechercher des sujets similaires à "afficher chiffre"