XL 2019 Effacer toute une ligne de cellules mais uniquement à l’intérieur d’un tableau

[Formulatix]

Bonjour,

Après moulte recherches et tests je tourne autour d’un code que je n’arrive pas à mettre en place pour modifier une macro (commentaires dans macro)

Plutôt que de créer une nouvelle ligne pour chaque enregistrement de données

A partir de la détection de la 1ere ligne dispo du tableau (cellule vide 1ère colonne)

Si je le souhaite (if then msgbox)

Effacer les valeurs de la ligne correspondante du tableau pour y enregistrer la série de données

Sub validaffect()

Dim tsaisaffect As ListObject
Dim tData As ListObject

Set tsaisaffect = ActiveSheet.ListObjects("t_saisaffect")
Set tData = ActiveSheet.ListObjects("t_affectation")

mb_affectmsgbox = MsgBox("Voulez vous confirmer ?", vbOKCancel, "CONFIRMATION")

    If mb_affectmsgbox = vbCancel Then
    Exit Sub
    End If

With tData
    '.ListRows.Add>>>>>>>>>>>>>>>>>>Ajout ligne supplémentaire au tableau  LIGNE CODE A SUPPRIMER
    
    ' $$$$$$$$$$$$ Au lieu de rajouter systématiquement une ligne supplémentaire au tableau
    ' $$$$$$$$$$$$$JE SOUHAITE utiliser la première ligne disponible correpondant à la &ère cellule vide colonne 1 pour enregistrer les valeurs
    
    Lastline = .ListRows.Count '>>>>>>>>>>Compte le nombre de lignes du tableau
    Nbrcol = .ListColumns.Count '>>>>>>>>>>Compte le nombre de colonnes du tableau
    Lastline = [t_affectation].End(xlDown).Row - 1 ' >>>>>>>redefini le N° de ligne du tableau de la 1ere cellule vide 1ere colonne
    
    MsgBox "Lastline" & Lastline & "nbrecol" & Nbrcol '>>>>>>>>>>>>>>>>verifie N° de ligne dispo et nombre colonnes si OK
    
    '$$$$$$$$$$$$$J'AI BESOIN de code supplémentaire pour effacer les valeurs de la ligne du tableau correspondante
      '?????????????.ClearContents
      
    .DataBodyRange(Lastline, 1) = tsaisaffect.DataBodyRange(1, 1).Offset(-1, 0)
  
    k = 2
 
    For j = 1 To 102
        If tsaisaffect.DataBodyRange(j, 1) = 1 Then
            .DataBodyRange(Lastline, k) = tsaisaffect.Range(j, 1).Offset(1, -1)
  
            k = k + 1
        End If
    Next j
End With

End Sub

 

[Phil69970]

Bonjour @Formulatix

Par principe un tableau structuré ne DOIT PAS avoir de ligne et colonne vide.
Donc tu supprimes toutes tes lignes et colonnes vides de ton (tes) tableau(x)
Et quand tu ajoutes une nouvelle ligne ton TS se remplit automatiquement par les formules que tu as dans ton tableau c'est un des avantages des TS donc sert toi en sinon supprimes tes TS dans ton fichier.

@Phil69970

 

[Formulatix]

Bonjour Phil69970

Je suis d'accord avec toi
Mais personne n'est à l'abri d'un besoin de modification suite à une erreur quelconque
Dans ce cas je souhaite pouvoir "provoquer" une ligne vide en effaçant la valeur d'une cellule de la colonne 1
et permettre une réécriture dans la ligne vidée

 

[fanch55]

Bonjour Phil69970

Je suis d'accord avec toi
Mais personne n'est à l'abri d'un besoin de modification suite à une erreur quelconque
Dans ce cas je souhaite pouvoir "provoquer" une ligne vide en effaçant la valeur d'une cellule de la colonne 1
et permettre une réécriture dans la ligne vidée

Bonsoir,
Pourquoi vider une ligne pour y ré-écrire ? et en ce cas, quel est le critère pour effacer celle-ci ?
Une action manuelle ?

Votre objectif semble plutôt de n'avoir que des lignes sans doublons,
c'est à dire que si le fournisseur n'est pas dans la table, on l'ajoute sinon on le met à jour .
Ai-je bon ?

 

[Phil69970]

Re

Mais personne n'est à l'abri d'un besoin de modification suite à une erreur quelconque

Si tu as une erreur dans une ligne d'un TS tu la modifies à la main directement dans le TS ou à travers un USF par exemple

@Phil69970

 

[Formulatix]

Bien vu
Mais pas que
Il peut également être nécessaire de nettoyer les lignes comprenant des erreurs d'affectation

En réalité mon soucis est plus global et j'essaie de le contourner en adaptant des bouts de codes avec mes maigres souvenirs de codage VB
Je ne souhaite pas non plus me lancer dans trop de USF pour garder la maîtrise de ce que je fais.


Le point de départ est que je cherche à permettre à un utilisateur de faire fonctionner cette feuille avec un accès strict à la sélection des cellules vertes et du bouton macro

Pour ça je sais faire est une protection de la feuille avec cellules verrouillées non sélectionnables
La macro intégrant incluant un unprotect protect le temps de son exécution

La conséquence est l'impossibilité d'insertion ou suppression de cellules lingnes et colonnes par l'utilisateur

Mais je fais peut être fausse route sur ma méthode?

 

[fanch55]

Vous n'avez pas répondu à ma supposition .
Mais si j'ai bon, le code ci-dessous devrait vous aider :

Sub ValidAffect()
Dim Target      As Range
Dim Line        As Long
Dim Col         As Long
Dim First       As String
Dim Tsaisaffect As ListObject
Dim TData       As ListObject

    Set Tsaisaffect = ActiveSheet.ListObjects("t_saisaffect")
    Set TData = ActiveSheet.ListObjects("t_affectation")
    
    If MsgBox("Voulez vous confirmer ?", vbOKCancel, "CONFIRMATION") = vbOK Then
        Fournisseur = Tsaisaffect.DataBodyRange(1, 1).Offset(-1, 0)
        With TData
            Set Target = .DataBodyRange.Columns(1).Find(Fournisseur, , xlValues, xlWhole)
            If Target Is Nothing Then
                Line = .ListRows.Add.Index
            Else
                Line = 1 + (Target.Row - .DataBodyRange.Row)
                .DataBodyRange.Rows(Line).ClearContents
            End If
            .DataBodyRange(Line, 1) = Fournisseur
            Set Target = Tsaisaffect.Range.Find("1", , xlValues, xlWhole)
            Col = 2
            Do While Not Target Is Nothing
                If Col = 2 Then First = Target.Address
                .DataBodyRange(Line, Col) = Target.Offset(, -1)
                Col = Col + 1
                Set Target = Tsaisaffect.Range.FindNext(Target)
                If Target.Address = First Then Set Target = Nothing
            Loop
        End With
    End If

End Sub

 

[Formulatix]

Dsl pour le retard et le manque de clarté de ma question

OUI Mon objectif est bien d'empêcher l'enregistrement d'un doublon de fournisseur
MAIS EGALEMENT de pouvoir rectifier une erreur enregistrée d'affectation d'un produit à un fournisseur
soit pas effacement des données de la ligne concernée par l'erreur et sa réécriture avec de nouvelles données
soit par la suppression de la ligne complète du tableau concernée par l'erreur

Je teste votre proposition et je reviens vers vous dès que possible
Merci pour cette aide

 

[Formulatix]

Votre code semble résoudre mon problème
le fait de détecter la position d'un fournisseur déjà enregistré et d'écraser ses affectations par les nouvelles, répond aux deux critères recherchés

Je vais faire plusieurs tests
il me reste à décortiquer votre code pour essayer de bien le comprendre
Je vous remercie beaucoup
et vous tiens informé

 

[Formulatix]

Bonjour,
Je pense avoir compris l'essentiel du code
et ça semble très bien fonctionner
MAIS
Il y a un cas non traité
Si un fournisseur est retiré de la liste des fournisseurs alors qu'il avait des affectations de produits enregistrés
Il ne sera pas détecté dans le tableau des affectations pour y être supprimé

Sub ValidAffect()
Dim Target      As Range
Dim Line        As Long
Dim Col         As Long
Dim First       As String
Dim Tsaisaffect As ListObject
Dim TData       As ListObject

    Set Tsaisaffect = ActiveSheet.ListObjects("t_saisaffect") 'Variable Tsaisaffect = tableau des saisies des affectations
    Set TData = ActiveSheet.ListObjects("t_affectation") 'Variable TData = tableau des affectations
    
    If MsgBox("Voulez vous confirmer ?", vbOKCancel, "CONFIRMATION") = vbOK Then
        Fournisseur = Tsaisaffect.DataBodyRange(1, 1).Offset(-1, 0) 'Variable fournisseur cellule au dessus de la 1ère cellule ligne1 colonne1 du tableau de saisie
        With TData 'Dans le tableau des affectations
            Set Target = .DataBodyRange.Columns(1).Find(Fournisseur, , xlValues, xlWhole) 'Variable Target = cherche la valeur fournisseur colonne 1 dans tableau des affectations  et definit sa position
            If Target Is Nothing Then 'Si valeur fournisseur recherchée par Target non trouvée
                Line = .ListRows.Add.Index 'rajout ligne supplémentaire au tableau des affectations
            Else
                Line = 1 + (Target.Row - .DataBodyRange.Row) 'Si valeur fournisseur recherchée par Target trouvée definition de la ligne dans tableau affectations
    MsgBox ("Ce fournisseur a déjà des produits affectés")
                .DataBodyRange.Rows(Line).ClearContents ' efface toutes les valeurs ligne entière du tableau
            End If
            .DataBodyRange(Line, 1) = Fournisseur 'copie la valeur fournisseur dans cellule 1ere colonne de la ligne
            Set Target = Tsaisaffect.Range.Find("1", , xlValues, xlWhole) 'Variable Target = cherche la valeur 1 dans tableau de saisie affectations  et definit sa position de ligne
            Col = 2 'valeur de base variable n°colonne pour la boucle
            Do While Not Target Is Nothing ' si Target n'a pas trouvé de valeur 1 dans le table de saisie ?????????
                If Col = 2 Then First = Target.Address ' si variable colonne = 2 variable First = position du 1 trouvée par target dans le tableau saisie affectation
                .DataBodyRange(Line, Col) = Target.Offset(, -1) 'recupère la valeur à copier dans la cellule à gauche du 1 trouvé par target
                Col = Col + 1 ' passe à la colonne suivante
                Set Target = Tsaisaffect.Range.FindNext(Target) 'recherche le 1 suivant dans le tableau saisie effectations
                If Target.Address = First Then Set Target = Nothing ' 'si le suivant est toujours la collonne 2 plus de cible définie
            Loop ' fin de boucle
        End With
    End If

 

[fanch55]

MAIS
Il y a un cas non traité
Si un fournisseur est retiré de la liste des fournisseurs alors qu'il avait des affectations de produits enregistrés
Il ne sera pas détecté dans le tableau des affectations

C'est un cas qui ne doit pas être effectué par la même sub.
Je suis en déplacement, je vous donnerai le code demain matin.

 

[fanch55]

Nouveau classeur.
Si un fournisseur est supprimé de t_fournisseurs, les lignes de t_saisaffect le concernant aussi .
La liste de validation de B1 de la feuille Affectation est également remise à jour .

 

[Formulatix]

Bonjour,
J’ai mis du temps suite votre réponse car cela m’est difficile de replonger dans le VBA
Grace à vos propositions j’ai pu adapter une solution hybride que je peux maîtriser
1/ Il y a 1 bug que je ne sais pas résoudre
J’ai essayé de contourner le .DataBodyRange.Rows(Line).ClearContents parce j’ai besoin de conserver les formules de calculs dans les colonnes masquées H,I,J feuille affectation

J’ai intégré un .DataBodyRange(Line, Col).ClearContents dans la boucle de collage de chaque nouvelle donnée MAIS cela n’efface évidemment pas toutes les données potentiellement présentes sur la ligne

L’idéal pour moi serait de pouvoir faire un .DataBodyRange(Line, toutes les colonnes après la date).ClearContents

2/ Je n’arrive pas à intégrer un code dans validaffect pour rendre visible ou invisible le bouton X ? superposé au bouton valider en fonction de la valeur à 0 d’une plage de cellule (t_affectation colonne 2)

Sub ValidAffect()
'ActiveWorkbook.Worksheets("Affectation").Unprotect "0000"

Dim Target      As Range
Dim Line        As Long
Dim Col         As Long
Dim First       As String
Dim Tsaisaffect As ListObject
Dim TData       As ListObject


'NOUVEAU CODE >>>>>>>>>>>>>>Je voudrais que le bouton alerte X superposé au bouton VALIDER passe en arrière plan (non visible)si t_affectation[HS] =0 et visible si t_affectation[HS] =1

    Set Tsaisaffect = ActiveSheet.ListObjects("t_saisaffect") 'Variable Tsaisaffect = tableau des saisies des affectations
    Set TData = ActiveSheet.ListObjects("t_affectation") 'Variable TData = tableau des affectations

    
    If MsgBox("Voulez vous confirmer ?", vbOKCancel, "CONFIRMATION") = vbOK Then
    
        Fournisseur = Tsaisaffect.DataBodyRange(1, 1).Offset(-1, 0) 'MsgBox ("Variable fournisseur = " & Fournisseur & " récupérée cellule(C2) (entête tableau t_saisaffect)")
        DateS = Tsaisaffect.DataBodyRange(1, 1).Offset(-2, 0) 'MsgBox ("Variable Date = " & DateS & " récupérée cellule(C1) de la feuille Affectation")
        
        With TData
        
            Set Target = .DataBodyRange.Columns(1).Find(Fournisseur, , xlValues, xlWhole) 'MsgBox ("Variable Target = cherche si fournisseur déjà existant dans la colonne 1 du tableau des affectations et definit sa ligne")
            
            If Target Is Nothing Then 'MsgBox ("Si fournisseur cherché par Target inexistant")
                Line = .ListRows.Add.Index 'MsgBox ("ligne supplémentaire rajoutée en N° " & Line & " du tableau des affectations")
            Else
                Line = 1 + (Target.Row - .DataBodyRange.Row) ' MsgBox ("Target à trouvé le numéro de ligne  " & Line & "correspondant au fournisseur existant dans tableau affectations")
                
' CODE A>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>.DataBodyRange.Rows(Line).ClearContents >>>>> PROBLEME à RESOUDRE Il faudrait n'effacer que les cellules de la ligne après le champs date
              
            End If
            
            .DataBodyRange(Line, 1).ClearContents 'Efface la cellule du Fournisseur trouvé dans t_affectation
            .DataBodyRange(Line, 1) = Fournisseur 'MsgBox (" a copié la valeur fournisseur dans cellule 1ere colonne de la ligne")
            .DataBodyRange(Line, 6).ClearContents 'Efface la cellule date ligne col6 dans t_affectation
            .DataBodyRange(Line, 6) = DateS 'MsgBox (" a copié la valeur date dans cellule 6ème colonne de la ligne")
            
            Set Target = Tsaisaffect.Range.Find("1", , xlValues, xlWhole) 'MsgBox ("Variable Target = cherche la 1ère valeur 1 dans tableau de saisie affectations  et definit sa position de ligne")
            
            Col = 7 ' MsgBox ("a définit la colonne " & Col & " comme cible après la date ")
            
            Do While Not Target Is Nothing 'MsgBox ("si Target n'a pas trouvé de valeur 1 dans le table de saisie ?????????")
              
                If Col = 7 Then First = Target.Address 'MsgBox ("Pour la colonne 7 recherche l'adresse de la 1ère valeur 1 dans t_saisaffect")
                
                .DataBodyRange(Line, Col).ClearContents 'Efface la valeur cellule cible
'CODE B >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>remplace le code A PROBLEME car toutes les valeurs potentiellement présentes sur laigne ne sont pas forcément remplacées
                
                .DataBodyRange(Line, Col) = Target.Offset(, -1) 'MsgBox (" a copié la date récupéree dans la cellule colonne à gauche du 1 trouvé par target")
                
                Col = Col + 1 'MsgBox (" passage à la colonne suivante N°" & Col & " du tableau ds affectations")
                Set Target = Tsaisaffect.Range.FindNext(Target) 'MsgBox ("recherche le 1 suivant dans le t_saisaffect")
                
                If Target.Address = First Then Set Target = Nothing 'MsgBox ("si prochain 1 absent dans t_saisaffect")
            
            Loop 'MsgBox (" fin de boucle")
        End With
    End If
                'ActiveWorkbook.Worksheets("Affectation").Protect "0000"
                'Worksheets("Affectation").EnableSelection = xlUnlockedCells

End Sub

 

[fanch55]

Bonsoir,
Je vois que vous n'avez pas retenu la suppression automatique dans le code de la feuille "Gestion Liste" .
N'oubliez pas de reconstruire la liste de validation si vous supprimez par exemple le 2ème fournisseur , sinon vous allez avoir une liste avec des lignes vides :

 

[Formulatix]

Bonjour,
Merci beaucoup pour cette aide précieuse
Je clos ce post