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

Formulatix

XLDnaute Nouveau
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
VB:
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
 

Pièces jointes

  • test2V10macro.xlsm
    900.9 KB · Affichages: 8
Solution
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 :
1685214231847.png

Phil69970

XLDnaute Barbatruc
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
 
Dernière édition:

Formulatix

XLDnaute Nouveau
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

XLDnaute Barbatruc
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 ? 🤔
 

Formulatix

XLDnaute Nouveau
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

XLDnaute Barbatruc
Vous n'avez pas répondu à ma supposition .
Mais si j'ai bon, le code ci-dessous devrait vous aider :
VB:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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é

VB:
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

XLDnaute Barbatruc
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 .
 

Pièces jointes

  • test2V10macro F55.xlsm
    905.6 KB · Affichages: 3

Formulatix

XLDnaute Nouveau
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)

Code:
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
 

Pièces jointes

  • 34Macro.xlsm
    75.2 KB · Affichages: 3

fanch55

XLDnaute Barbatruc
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 :
1685214231847.png
 

Pièces jointes

  • 34Macro F55.xlsm
    77 KB · Affichages: 10

Discussions similaires

Réponses
3
Affichages
274