Autres Remplir cellule en fonction d'une autre et supprimer lignes après un filtre

[grotsblues]

Bonsoir le forum

J'ai un fichier excel avec 2 onglets, je souhaiterai supprimer les lignes visible après un filtre et le code que j'ai mis dans l'onglet indicateur échues, filtre bien mais ne supprime rien, je ne comprend pourquoi.
De plus, j'ai trouvé un code sur le forum qui permet d'obliger une personne à remplir une cellule si une autre est remplie.
Exemple dans mon fichier si N11 et N13 est non vide alors remplir obligatoirement au format date O11 et O13 sachant que le nombre de ligne varie. Mais je n'arrive pas à le faire fonctionner.

Merci pour vos réponses

 

[fanch55]

Bonsoir,
Pas trouvé de code dans l'onglet "indicateur échues".
Pour la première partie:
code à tester ( dé-commenter le .delete pour faire la suppression effective )

Sub Test_Filter_and_Delete()
    Delete_Table "Nb Jours", 5
    Delete_Table 20, 4
    Delete_Table 30, "DOUBLONS"
End Sub

Function Delete_Table(Field, Criteria) As Integer
Dim Col_Index As Integer
Application.DisplayAlerts = False
    With [Tableau_Indicateurs_Achats.accdb106]
        Select Case True
            Case Not IsNumeric(Field)
                On Error Resume Next
                    Col_Index = .ListObject.ListColumns(Field).Index
                On Error GoTo 0
            Case Field <= 0:                Col_Index = Field
            Case Field > .Columns.Count:    Col_Index = 0
            Case Else:                      Col_Index = Field
        End Select
        If Col_Index > 0 Then
            .AutoFilter Field:=Col_Index, Criteria1:=Criteria
            N = Application.Subtotal(3, .Columns(Col_Index))
            If N > 0 Then
    '            .Delete
                MsgBox N & " lignes supprimées"
            End If
            .AutoFilter Field:=Col_Index
        End If
    End With
Application.DisplayAlerts = True
Delete_Table = N
End Function

 

[grotsblues]

Bonsoir fanch55
Le code est dans module indicateur échue, merci je teste de suite

 

[grotsblues]

Bonsoir je me suis peut être mal expliqué, mais il faudrait faire un filtre sur la colonne 30 "DOUBLONS" et supprimer les lignes visibles. Je viens de tester votre code et il ne supprime rien.
Je ne vois pas le problème car j ai mis le code suivant, il fait bien le filtre mais ne supprime pas non plus.

Merci pour votre aide

Range("AD4:AD" & der).Formula = "=IF(RC[-1]=R[-1]C[-1],""DOUBLONS"",FALSE)"
Range("AD4:AD" & der) = Range("AD4:AD" & der).Value

Sheets("INDICATEUR ECHUE").Select
On Error Resume Next
ActiveSheet.ListObjects("Tableau_Indicateurs_Achats.accdb106").Range. _
AutoFilter Field:=30, Criteria1:="DOUBLONS"
Range("_filterdatabase").Offset(1, 0).Resize(Range("_filterdatabase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
ActiveSheet.ShowAllData

 

[fanch55]

Bonsoir,
Je pense que vous n'avez pas mis en oeuvre ce que j'ai indiqué dans mon post.
Ci-joint le classeur avec la sub Test_Filter_and_Delete dans la feuille "Indicateur Echue" à exécuter

 

[grotsblues]

De fait cela fonctionne parfaitement, mais pour ma compréhension, pourquoi le copier sur la feuille et non dans le module avec sheets ("indicateur...).select. C'est quoi la différence ?

 

[fanch55]

Pas d'importance dans ce contexte, mais si cela ne sert qu'à la feuille, autant les mettre dans celle-ci.
On ne met dans des modules que les sub/functions qui sont susceptibles d'être appelées dans plusieurs endroits, cela évite d'avoir un tas de sub/functions qui ne servent à rien si vous supprimez la feuille ...

 

[fanch55]

Sinon, pour la deuxième partie, je n'ai pas compris la demande

C'est la colonne métier qui doit avoir une date si la colonne N est non vide ?

 

[fanch55]

Ooops, c'est pour l'autre onglet ...

 

[grotsblues]

Ok j'ai compris et avez vous une idée pour obliger un utilisateur à remplir une cellule ( voir mon fichier onglet 1 échue). Car je souhaiterai que l'utilisateur soit obliger de remplir les cellules exemple O11 et O13 car les cellules N11 et N13. J'ai trouvé le code suivant sur les forums mais je n'arrive pas à le faire fonctionner.
Merci pour votre aide
Sub Macro1()

Dim alerte As String

'texte du message invitant à compléter la cellule : à changer pour désigner une autre cellule
alerte = "Veuillez compléter le contenu de la cellule A1 - Merci d'avance : "
'Cellule à tester : à changer pour désigner une autre cellule
Range("O6").Select
'boucle demandant de compléter la cellule : pour sortir de la boucle il faut impérativement mettre quelque chose en A1
' invitation à compléter la cellule : à changer pour désigner une autre cellule
Do While ActiveCell.Value = Empty
Range("O6").Value = InputBox(alerte)
Loop
End Sub

 

[grotsblues]

J'ai oublié de préciser que le format doit être au format date et que le nombre de ligne varie.
merci

 

[fanch55]

A tester:

 

[grotsblues]

Merci pour votre retour mais quand je remplie une cellule exemple N9 elle me renvoie bien un message ok rentre une date mais quand je rentre une date
1) elle ne remplie pas la cellule qui suit et 2) je reste bloqué. Je suis obligé de sortir en faisant ctrl alt sup. Je ne comprend pas.
merci pour votre retour

 

[fanch55]

Chez moi en Excel 2016, cela fonctionne correctement

Quelle est votre version d'Excel ?
Ci-joint le classeur avec un stop avant la demande de date, faites du pas à pas et indiquez-moi quelle est la ligne qui pose problème .
Si figeage, avant de faire ctrl alt sup, essayez ctrl Pause ou ctrl Attn

 

[grotsblues]

Bonsoir
J'ai excel 2007 et elle bloque ici:
D = InputBox(Target.Value & vbLf & vbLf & "Entrez une date")
Select Case TrueSelect Case True 'ICI
Elle tourne en boucle et ne copie pas la date dans la cellule d'à coté.
merci pour votre retour