Le filtre filtre tout, il devient inefficace Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 24 mai 2019, 07:02

Bonjour à tous,

Je viens vous voir car je fais face actuellement à un problème .

Pour contextualiser, je travaille actuellement sur un UserForm permettant la création de document. Sur l'UserForm se trouve une ComboBox (appelée "ComboBox1" dans mon exemple). Dans cette ComboBox, nous pouvons trouver le nom de Templates déjà pré-enregistrés.
Dans deux Tables étant sur la feuille "Database" (la "Table1" et la "Table2") se trouvent des informations liées aux Templates (voir screen où on peut voir les Datas gardé en mémoire).
Je souhaite que lorsqu'on sélectionne un Template dans la "ComboBox1", les informations se trouvant dans la "Table1" et la "Table2" se copient dans 2 autres Tables (voir screen2 pour voir la tête des deux autres Tables).

Mon programme marche en soit, mais je me suis rendu compte que si le filtre filtre toute la Table (1 ou 2) car on n'a pas rentré de données pour le Template sélectionné, il copiera alors toutes les valeurs de la Table (voir screen 3 où on a choisit la valeur de "Template2" dans la ComboBox "ComboBox1").
J'ai essaye de résoudre le problème en rajoutant des conditions, mais je n'ai pas réussi.

Je vous demande donc si vous saurez quelles modifications faire afin qu'il ne copie aucune valeur dans ce cas précis (voir screen 4 où on voit le résultat attendu dans le cas du screen 3)

En vous remerciant par avance,
Benoit.

PS : Voici le code
Private Sub ComboBox1()

    '----------------------------------------------------------------------
    'Je filtre la Table1 pour n'avoir que les lignes liees a mon document
    '----------------------------------------------------------------------

    Dim Filter As String
    Filter = ComboBox1.value
    ThisWorkbook.Sheets("Database").ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=Filter

    '----------------------------------------------------------------------------------------------
    'Je copie les lignes de la Table1 et je les mets dans une autre Table dans une autre feuille
    '----------------------------------------------------------------------------------------------

    With ThisWorkbook
        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table1").ListColumns(1).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        Cells(LastRow, 1).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table1").ListColumns(2).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 2).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table1").ListColumns(3).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 3).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table1").ListColumns(4).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 4).Select
        Selection.PasteSpecial xlPasteValues

        Application.CutCopyMode = False
        
        '+++++++++++++++++++++++++++++++++
        
    With ThisWorkbook
         .Sheets("Database").ListObjects("Table2").Range.AutoFilter Field:=1, Criteria1:=Filter
        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table2").ListColumns(1).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        LastRow = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row
        Cells(LastRow, 1).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table2").ListColumns(2).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 8).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table2").ListColumns(3).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 9).Select
        Selection.PasteSpecial xlPasteValues

        .Worksheets("DataBase").Activate
        .Sheets("DataBase").ListObjects("Table2").ListColumns(4).DataBodyRange.Select
        Selection.Copy

        .Worksheets("Feuille1").Activate
        Cells(LastRow, 10).Select
        Selection.PasteSpecial xlPasteValues

        Application.CutCopyMode = False
        
End Sub




EDIT1 : Ah oui pardon, il y a une colonne en plus sur le screen 1 mais c'est une erreur de ma part, n'y faites pas attention

EDIT2 : Il manquait une partie du code... Désolé, j'ai corrigé
Screen1.PNG
Screen2.PNG
Screen2.PNG (8.52 Kio) Vu 102 fois
Screen3.PNG
Screen4.PNG
Screen4.PNG (11.12 Kio) Vu 102 fois
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 24 mai 2019, 07:04

Je vous joins un fichier fonctionnel.

Cordialement,
Benoit.
Filter problem.xlsm
(136.07 Kio) Téléchargé 4 fois
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'950
Appréciations reçues : 464
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 24 mai 2019, 08:41

Bonjour,
Ta procédure revisitée.
A tester !... ;;)
Cdlt.
Filter problem.xlsm
(140.4 Kio) Téléchargé 4 fois
'----------------------------------------------------------------------------------------------------------
    strFilter = ComboBox1.value
    '----------------------------------------------------------------------------------------------------------
    Table1.Range.AutoFilter Field:=1, Criteria1:=strFilter

    Set rCell = Table3.InsertRowRange.Cells(1)

    With Table1.AutoFilter.Range
        On Error Resume Next
        Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If Not rng2 Is Nothing Then
        Set rng = Table1.AutoFilter.Range
        rng.Offset(1, 0).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
        rCell.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If

    Table1.Range.AutoFilter Field:=1

    '----------------------------------------------------------------------------------------------------------
    Table2.Range.AutoFilter Field:=1, Criteria1:=strFilter
    Set rCell = Table4.InsertRowRange.Cells(1)

    With Table2.AutoFilter.Range
        On Error Resume Next
        Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With

    If Not rng2 Is Nothing Then
        Set rng = Table2.AutoFilter.Range
        rng.Offset(1, 1).Resize(rng.Rows.Count, rng.Columns.Count - 1).SpecialCells(xlCellTypeVisible).Copy
        rCell.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
    End If
    
    Table2.Range.AutoFilter Field:=1
    '----------------------------------------------------------------------------------------------------------
1 membre du forum aime ce message.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 24 mai 2019, 09:18

Cela fonctionne ! Merci !

Alors j'ai utilisé le mode pas à pas pour comprendre, mais je n'ai pas réussi... (Je ne maitrise pas tres bien VBA)
La chose qui m'interpelle le plus, c'est l'offcet. Pourquoi t'es-tu décalé d'une ligne au début ?

Encore merci :)
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'950
Appréciations reçues : 464
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 24 mai 2019, 09:45

Re,
On ne copie pas les en-têtes de ligne!... ;;)
On doit donc décaler d'une ligne pour Table1.
Pour table2, on décale d'une ligne et d'une colonne…
Cdlt.
1 membre du forum aime ce message.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 24 mai 2019, 10:15

Ah... Suis-je bete...

Merci :)
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 29 mai 2019, 03:53

Bonjour tout le monde :)

Ce message s'adresse principalement à ceux qui veulent récupérer le code plus tard.

Je viens de réaliser que lorsque je fais le test pour savoir si la Table4 est vide :
If Table4.DataBodyRange Is Nothing Then

	(Code)

Else

	(Code)

End If
Cela ne donne pas le résultat escompté. En effet, le .DataBodyRange ne sera pas égale à "rien" même si le tableau est vide. La fonction proposée par Jean-Eric semble copier une ligne vide. Donc, même s'il n'y a rien, Excel considère qu'il y a quelque chose (probablement un bug). J'ai trouvé une solution pour résoudre le problème :
If Table4.Range(2, 1) = "" Then 	'On regarde la deuxième ligne car se trouve sur la 1ere les en-têtes

	(Code)

Else

	(Code)

End If
De mon côté ça marche ;)
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'950
Appréciations reçues : 464
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 29 mai 2019, 08:42

Bonjour,
Il n' a pas de raison que cela ne fonctionne pas.
Aurais-tu modifié quelque chose ?
For Each Table In ws2.ListObjects
        If Not Table.DataBodyRange Is Nothing Then
            Table.DataBodyRange.Delete
        End If
    Next Table
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
B
Benoit M
Jeune membre
Jeune membre
Messages : 43
Appréciation reçue : 1
Inscrit le : 23 mai 2019
Version d'Excel : 2016 EN

Message par Benoit M » 29 mai 2019, 09:47

Bonjour Jean-Eric,

J'ai juste changé le nom de toutes les variables afin qu'elles soient en concordance avec mon fichier originel et décalé les offcets du code des Table1/3 d'une colonne.

Le passage du code que tu viens d'envoyer et écrit légèrement différemment, mais cela revient au même (sauf erreur de ma part).
With Table3
	If Not .DataBodyRange Is Nothing Then
		.DataBodyRange.Delete
	End If
End With

With Table4
	If Not .DataBodyRange Is Nothing Then
		.DataBodyRange.Delete
	End If
End With
A part ça, j'ai fais en sorte de toucher le moins de choses possibles. C'est pourquoi je pense qu'il s'agit d'un bug d'excel (mais je peux encore me tromper).
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'950
Appréciations reçues : 464
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 29 mai 2019, 10:48

Re,
Envoie ton fichier. ;;)
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message