Pb avec tableau gestion de materiel

bonjour

je faits un tableau de gestion de distribution de materiel

je souhaite avoir l'affichage du materiel dispo ou sorti,

j'ai fait faire le code pas GPT car j'y connais rien mais il semble galérer.

Quand H4 est nonvide Q3 affiche "NON", quand L est nonvide, Q3 repasse à "OUI"

le problem est quand je ressaisi 2 M en H5, Q3 reste sur "oui" alors qu'il devrait repasser en "NON",

Merci pour votre aide

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.EnableEvents Then Exit Sub

    On Error GoTo ErrorHandler
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    ' Si modification dans H, L ou P3:P30 ? recalcul
    If Not Intersect(Target, Range("H:H,L:L,P3:P30")) Is Nothing Then
        Call MettreAJourColonneQ
    End If

ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub MettreAJourColonneQ()
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim trouve As Boolean
    Dim auMoinsUnLNonVide As Boolean
    Dim valP As Variant

    Set ws = Me

    For i = 3 To 30
        valP = ws.Cells(i, "P").Value
        If valP <> "" Then
            trouve = False
            auMoinsUnLNonVide = False

            For j = 1 To ws.Cells(ws.Rows.Count, "H").End(xlUp).row
                If ws.Cells(j, "H").Value = valP Then
                    trouve = True
                    If ws.Cells(j, "L").Value <> "" Then
                        auMoinsUnLNonVide = True
                    End If
                End If
            Next j

            If trouve Then
                If auMoinsUnLNonVide Then
                    ws.Cells(i, "Q").Value = "OUI"
                Else
                    ws.Cells(i, "Q").Value = "NON"
                End If
            Else
                ws.Cells(i, "Q").Value = ""
            End If
        Else
            ws.Cells(i, "Q").Value = ""
        End If
    Next i
End Sub

il a fini par me generer un code qui fonctionne apres 50 tentative,

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim tbl1Range As Range, tbl2Range As Range
    Dim cell As Range, lookupCell As Range
    Dim dict As Object
    Dim i As Long

    Set ws = Me
    Set tbl1Range = ws.Range("A3:L15000")
    Set tbl2Range = ws.Range("P3:P30")
    Set dict = CreateObject("Scripting.Dictionary")

    ' Vérifie si la modification concerne la colonne H ou L du tableau1
    If Intersect(Target, ws.Range("H3:H15000,L3:L15000")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    ' Réinitialise les valeurs de Q3:Q30
    ws.Range("Q3:Q30").Value = ""

    ' Parcourt toutes les lignes du tableau1
    For Each cell In ws.Range("H3:H15000")
        If cell.Value <> "" Then
            ' Recherche si la valeur existe dans le tableau2
            Set lookupCell = tbl2Range.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not lookupCell Is Nothing Then
                ' Vérifie si la colonne L de la même ligne est vide
                If ws.Cells(cell.row, "L").Value = "" Then
                    ws.Cells(lookupCell.row, "Q").Value = "NON"
                Else
                    ' Si déjà marqué NON par une autre ligne, reste NON
                    If ws.Cells(lookupCell.row, "Q").Value <> "NON" Then
                        ws.Cells(lookupCell.row, "Q").Value = "OUI"
                    End If
                End If
            End If
        End If
    Next cell

    Application.EnableEvents = True
End Sub

Bonjour

Si déjà tu utilisais un tableau structuré sans ligne vide tu n'aurais rien à coder car une simple formule te remplirait ta colonne de disponibilités...