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

fanch55

XLDnaute Barbatruc

• 3 Octobre 2020

• #2

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 )

VB:

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

 

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #3

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

 

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #4

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

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 4 Octobre 2020

• #5

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

 

Pièces jointes

• TEST F55.xlsm

  910 KB · Affichages: 3

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #6

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 ?

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 4 Octobre 2020

• #7

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

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 4 Octobre 2020

• #8

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 ?

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 4 Octobre 2020

• #9

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

 

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #10

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

 

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #11

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

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 4 Octobre 2020

• #12

A tester:

 

Pièces jointes

• TEST F55.xlsm

  911.3 KB · Affichages: 3

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 4 Octobre 2020

• #13

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

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 5 Octobre 2020

• #14

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

 

Pièces jointes

• TEST F55.xlsm

  911.5 KB · Affichages: 5

Vote positif 0 Vote négatif

grotsblues

XLDnaute Occasionnel

• 5 Octobre 2020

• #15

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

 

Vote positif 0 Vote négatif