Microsoft 365 Ecrasement d'une ligne si déjà existante

sebastien176 · 11 Octobre 2024

Bonjour à tous,

Je bloque sur le développement de mon code

J'aimerais que quand je rentre des données sur la feuille "Résultat inventaire", qu'il y ai une vérification de correspondance sur les colonnes "date", "N° de ligne et "N° de colonne" de la feuille "Data"
Si ces 3 critères sont remplis alors, on écrase les données existantes

exemple:
Sur le mois d'octobre, la ligne 13(Vendredi 04 octobre) est déjà rempli donc déjà enregistrée sur la feuille "Data"
Si je remplace des valeurs déjà existantes alors je ne crée pas de nouvelles lignes mais écrase la ligne existante de la feuille "Data"

Ci-dessous le code que j'ai sur la feuille "Résultat inventaire" pour enregistrer les saisie
Aujourd'hui, si je décide de modifier une ligne de la feuille "Résultats inventaire" alors elle est enregistrée sur une nouvelle ligne de la feuille "Data" et je ne peux donc pas exploiter cette base pour des calculs

Je vous remercie par avance de votre aide

Bonne journée à tous

Seb

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Ligne As Long
Dim Nb_Colonne As Long

'On sort si on n'est pas dans la plage active
If Intersect(Target, Range("D10😛40")) Is Nothing Then Exit Sub
If ctrl = True Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

Ligne = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row + 1

Sheets("Data").Range("A" & Ligne).Value = Cells(Target.Row, "A")
Sheets("Data").Range("B" & Ligne).Value = Target.Value
Sheets("Data").Range("C" & Ligne).Value = Target.Row
Sheets("Data").Range("D" & Ligne).Value = Target.Column

End Sub

sylvanu · 11 Octobre 2024

Bonjour Sébastien,
( utilisez la balise </> pour le code c'est plus lisible. A droite de l'icone GIF )
Un essai en PJ avec :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne%, Nb_Colonne%, Tablo, i%, Dat
    'On sort si on n'est pas dans la plage active
    If Intersect(Target, Range("D10:P40")) Is Nothing Then Exit Sub
    If ctrl = True Or Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Ligne = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row + 1
    LigResult = Target.Row
    ColResult = Target.Column
    DateResult = Cells(Target.Row, "A")
    With Sheets("Data")
        Tablo = .[A1].CurrentRegion     ' On met Data dans un tableau, plus rapide
        Dat = Cells(Target.Row, "A")    ' On mémorise la...

sylvanu · 11 Octobre 2024

Bonjour Sébastien,
( utilisez la balise </> pour le code c'est plus lisible. A droite de l'icone GIF )
Un essai en PJ avec :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne%, Nb_Colonne%, Tablo, i%, Dat
    'On sort si on n'est pas dans la plage active
    If Intersect(Target, Range("D10:P40")) Is Nothing Then Exit Sub
    If ctrl = True Or Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Ligne = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row + 1
    LigResult = Target.Row
    ColResult = Target.Column
    DateResult = Cells(Target.Row, "A")
    With Sheets("Data")
        Tablo = .[A1].CurrentRegion     ' On met Data dans un tableau, plus rapide
        Dat = Cells(Target.Row, "A")    ' On mémorise la date, pour éviter de la lire N fois
        For i = 1 To UBound(Tablo)      ' On cherche s'il y a la bonne configuration, si trouvé on memorise ligne en ExisteEnLigne
            If Tablo(i, 1) = Dat And Tablo(i, 3) = Target.Row And Tablo(i, 4) = Target.Column Then
                Ligne = i               ' On réactualise le N° de ligne
                Exit For                ' On sort car trouvé
            End If
        Next i
        ' On enregistre les valeurs. Ligne vaut soit la dernière soit celle trouvée
        .Range("A" & Ligne) = Cells(Target.Row, "A")
        .Range("B" & Ligne) = Target.Value
        .Range("C" & Ligne) = Target.Row
        .Range("D" & Ligne) = Target.Column
    End With
End Sub

sebastien176 · 11 Octobre 2024

sylvanu à dit:

Bonjour Sébastien,
( utilisez la balise </> pour le code c'est plus lisible. A droite de l'icone GIF )
Un essai en PJ avec :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne%, Nb_Colonne%, Tablo, i%, Dat
    'On sort si on n'est pas dans la plage active
    If Intersect(Target, Range("D10:P40")) Is Nothing Then Exit Sub
    If ctrl = True Or Target.Count > 1 Or Target.Value = "" Then Exit Sub
    Ligne = Sheets("Data").Range("B" & Rows.Count).End(xlUp).Row + 1
    LigResult = Target.Row
    ColResult = Target.Column
    DateResult = Cells(Target.Row, "A")
    With Sheets("Data")
        Tablo = .[A1].CurrentRegion     ' On met Data dans un tableau, plus rapide
        Dat = Cells(Target.Row, "A")    ' On mémorise la date, pour éviter de la lire N fois
        For i = 1 To UBound(Tablo)      ' On cherche s'il y a la bonne configuration, si trouvé on memorise ligne en ExisteEnLigne
            If Tablo(i, 1) = Dat And Tablo(i, 3) = Target.Row And Tablo(i, 4) = Target.Column Then
                Ligne = i               ' On réactualise le N° de ligne
                Exit For                ' On sort car trouvé
            End If
        Next i
        ' On enregistre les valeurs. Ligne vaut soit la dernière soit celle trouvée
        .Range("A" & Ligne) = Cells(Target.Row, "A")
        .Range("B" & Ligne) = Target.Value
        .Range("C" & Ligne) = Target.Row
        .Range("D" & Ligne) = Target.Column
    End With
End Sub

Super Sylvanu
Je te remercie beaucoup pour ton aide et ta rapidité
Merci aussi pour l'info de la balise 😉
Bonne journée

Seb

Microsoft 365 Ecrasement d'une ligne si déjà existante

sebastien176

XLDnaute Junior

Pièces jointes

sylvanu

sylvanu

XLDnaute Barbatruc

Pièces jointes

sebastien176

XLDnaute Junior

Discussions similaires

Microsoft 365 Ecrasement d'une ligne si déjà existante

sebastien176

XLDnaute Junior

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

sebastien176

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency