Filtrer ListView entre 2 Dates et transfert resultat vers feuille Excel

Le 14/11/2024 à 08:47

Bonjour tout le monde,

Je sollicite votre aide pour résoudre un problème concernant le transfert de filtrage de listView entre 2 dates vers autre feuille.

Le transfert s'effectue vers l'autre feuille ,mais ya des cellules en format dates qui se convertissent en "mm/jj/aaaa" au lieu de garder leur format "jj/mm/aaaa".

Et dans les colonnes "D","E" et "F" des cellules se formatent en Texte.La feuille Releve reçoit le résultat du filtrage de la listView

Dans le ficher ci-joint; il ya 3 feuilles: "BD1","BD2", et "Releve". Dans l'UserForm1 il ya la ListView ,la Combobox1 qui permet de choisir l'une des 2BD,

les TextBox1 et TextBox2 qui affichent automatiquement les dates MIN et MAX de la colonne "A" de la base choisie et les TextBox1 et TextBox2 (*) pour saisir dates

Début et Date Fin et enfin le bouton de commande qui appel les macros Filtre et Transfert.

15listview-filtrer-entre-2-dates-et-transfert-vers-feuille.zip (340.88 Ko)

Edit modo : (*) textBox 3 et TextBox4 en lieu et place de Texbox1 et Textbox 2

Le 14/11/2024 à 11:12

Bonjour

Allez dans l'usf et modifiez le code ci-dessous

Function CopyDataFromListViewToSheet()
Dim ws As Worksheet
Dim i As Integer, j As Integer
Dim ligne As Integer
Dim derlig As Long

derlig = Range("A" & Rows.Count).End(xlUp).Row

Set ws = ThisWorkbook.Sheets("Releve")
ligne = 4
With ws
    For i = 1 To ListView1.ListItems.Count
        .Cells(ligne, 1).Value = Format(ListView1.ListItems(i).Text, "mm/dd/yyyy")
    For j = 2 - 1 To 6 - 1
        .Cells(ligne, j + 1).Value = ListView1.ListItems(i).SubItems(j)
    Next j
    ligne = ligne + 1
Next i
End With
End Function

Par ailleurs veillez à la déclaration de variable qui manque dans certains codes.

Vous pouvez aussi modifier le code ci-dessous. On évite les activate et de répéter le nom de la feuille à chaque ligne

Private Sub CommandButton1_Click()
Dim i As Integer
Dim lastline As Integer

With Sheets("Releve")
    lastline = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A4:F" & lastline).Clear
    .Range("B1:B2").Clear
    .Range("A1:A2") = "Releve de la feuille" & Worksheets(ComboBox1.Value).Name
    'Me.TextBox3 = Format(CDate(Me.TextBox3), "dd/mm/yyyy")
    .Range("B1") = CDate(Me.TextBox3.Value)

    'Me.TextBox4 = Format(CDate(Me.TextBox4), "dd/mm/yyyy")
    .Range("B2") = CDate(Me.TextBox4.Value)
End With

Chercher_Entre_Deux_Dates_Dans_listview
CopyDataFromListViewToSheet

Sheets("Releve").Activate
Call Module1.FusionnerA1_A2
End Sub

NB :
- la macro fusionnerA1_A2 n'est pas dans le fichier posté
- à voir pourquoi vous avez mis les deux lignes me.textbox3.... et me.textbox4...., cela ne me semble pas nécessaire si vous entrez vos dates au format dd-mm-yyyy. Je les ai désactivées dans le code

Vous pouvez aussi modifier ceci :
- Le code Sub ComboBox1_Fil() ne sert à rien. Je ne comprends pas le pourquoi ?? Vous pouvez le supprimer et aussi supprimer les 2 lignes ComboBox1_Fil et ListViewFil dans la sub Initialize
- Sub initialize supprimez aussi la ligne --> Worksheets(ComboBox1.Value).Activate

A voir si si vous voulez que je regarde pour d'autres modifications. Il y a pas mal de petites choses à corriger

Cordialement

Le 14/11/2024 à 15:53

Bonjour Dan

ça marche pour la colonne "A" de la feuille "Releve";les dates se mettent correctement en jj/mm/aaaa

21listview-filtrer-entre-2-dates-et-transfert-vers-feuille.zip (342.61 Ko)

Merci

Le 14/11/2024 à 16:59

Re

ça marche pour la colonne "A" de la feuille "Releve";les dates se mettent correctement en jj/mm/aaaa

Ok.

Pourquoi me repostez-vous le fichier en fait ? Vous vouliez me montrer les modifications ?

Le 14/11/2024 à 18:31

Bonsoir Dan

oui j'ai reposter le fichier si vous voulez voir les modifs

cordialement

Le 14/11/2024 à 18:34

Re

Ok. Je vais vous poster ce que vous pouvez modifier mais avant d'avancer; il y a quelque chose que vous devez absolument modifier
Dans chacune de vos feuilles vous avez colorié les lignes et mis des bordures jusqu'au bas de vos feuilles (soit donc jusque la ligne 1048576 !!!)
A ne pas faire, c'est le meilleur moyen d'alourdir votre fichier inutilement. Actuellement votre fichier pèse lourd 1,4 MO alors que vous n'avez qu'un minimum de données.

Je vous suggère donc de supprimer toutes les lignes depuis la ligne 1000 jusque la fin de la feuille, de manière à n'avoir qu'une couleur et les bordures jusque la ligne 1000 ou 2000 si vous voulez. Une fois fait vérifiez bien que vous n'avez plus de bordures et couleur

Une fois fait enregistrez le fichier, fermez le puis le réouvrir. Vous verrez que l'ouverture est plus rapide et surtout que poids de votre fichier va descendre de 1,4 MO à 240 Ko !

Dites moi si ok puis je vous donne les modifications userform

Le 14/11/2024 à 19:51

Bonsoir Dan

c'est OK

J'ai suivi tes suggestions(suppression des lignes après le tableau) ; le fichier pèse maintenant 125 ko

Merci

Le 14/11/2024 à 21:13

Re

J'ai suivi tes suggestions(suppression des lignes après le tableau) ; le fichier pèse maintenant 125 ko

Parfait cela !

Voici ce que vous pouvez modifier dans les codes de l'userform

1. Sub Initialize : Remplacez la par celle ci-dessous

Private Sub UserForm_Initialize()
Dim i As Byte

With Me
    .Label1.Caption = "Choix" + vbCrLf + "Base"
    .Label2.Caption = "Relevé" + vbCrLf + "Date Début:"
    .Label3.Caption = "Relevé" + vbCrLf + "Date Fin:"
    .Label4.Caption = "Date Début >=" + vbCrLf + " Date MIN:"
    .Label5.Caption = "Date Fin <=" + vbCrLf + "Date MAX:"

    For i = 1 To Sheets.Count
      .ComboBox1.AddItem Sheets(i).Name
    Next i
End With

With ListView1
    .View = lvwReport
    .CheckBoxes = False
    .FullRowSelect = True
    .Gridlines = True
    With .ColumnHeaders
       .Clear
       .Add , , "Date", 50
       .Add , , "Ctegorie", 60
       .Add , , "Libelle", 260
       .Add , , "Debit", 60
       .Add , , "Credit", 60
       .Add , , "Solde", 60
    End With
End With
End Sub

2. Sub Combobox1_change : Remplacez-la par celle ci-dessous

Private Sub ComboBox1_Change()
Dim Min As Date, Max As Date
Dim f As Worksheet
Dim lastrow As Integer

ListView1.ListItems.Clear
Set f = Worksheets(ComboBox1.Value)
lastrow = f.Range("A" & Rows.Count).End(xlUp).Row

With f
    TextBox1 = Format(CDate(.Range("L1")), "dd/mm/yyyy")
    TextBox2 = Format(CDate(.Range("L2")), "dd/mm/yyyy")
    .Range("L1").FormulaR1C1 = "=MIN(R[3]C[-11]:R[" & lastrow & "]C[-11])"
    .Range("L2").FormulaR1C1 = "=MAX(R[2]C[-11]:R[" & lastrow & "]C[-11])"
End With

Call ListViewFil(f, lastrow)
End Sub

3. Sub Listvieewfil --> à remplacer par celle ci-dessous

Sub ListViewFil(f As Worksheet, lastrow As Integer)
Dim r As Integer, c As Integer
Dim li As Object

For r = 4 To lastrow
    Set li = ListView1.ListItems.Add(, , f.Cells(r, 1))
    For c = 2 To 6
        li.ListSubItems.Add , , f.Cells(r, c)
    Next c
Next r
End Sub

4. Dans les deux feuilles BD1 et BD2, vous pouvez modifier les deux formules qui se trouve en D2 et E2 comme ceci
en D2 --> =SOMME(INDIRECT("D4:D"&NBVAL($C:$C)))
en E2 --> =SOMME(INDIRECT("E4:E"&NBVAL($C:$C)))

Faite un test, les exécutions de code devraient se faire plus vite

Si ok je peux voir pour le reste de codes si vous voulez

Crdlt

EDIT : attention j'ai modifié la sub Combobox1_change reprise au point 2. (J'avais omis une ligne de code)

Le 15/11/2024 à 04:30

Bonjour Dan

Avec les modifications l'execution est plus rapide.

OK, tu peux voir le reste. Ya aussi, apres transfert de ListView vers la feuille "Releve"; colonnes "D","E", et "F", des cellules se formatent en Texte.

Crdlt

Le 15/11/2024 à 09:54

Re,

Ok parfait.

Toutefois dans la Private Sub ComboBox1_Change(), rajoutez aussi cette ligne juste après la ligne ListView1.ListItems.Clear
cela évite un bug si par hasard vous videz la combox de son info

If ComboBox1.Value = vbNullString Then Exit Sub

Dans mon post précédent point 4, j'ai donné deux formules à placer en D2 et E2. en analysant les autres codes je me suis aperçu que c'était un code dans les feuilles et liés aux boutons Tabl qui mettaient ces formules. Nul besoin d'un code pour cela dans votre cas.
- En F2 --> =E2-D2
- D2 et E2 : voir mon point 4 du post précédent. Pour remettre les formules si elles n'y sont plus (due au code sivous l'avez exécuté avant les changements ci-après)
- Supprimez les codes Private Sub Bouton1_Click() et le bouton Ligne 4 dans les 3 feuilles BD1, BD2 et relevé
- Toujours dans les trois feuilles remplacez le code FinTabl_click par celui ci-dessous :

Private Sub FinTabl_Click()
'selection debut ou fin tableau
Dim DerLin As Long

DerLin = Cells(Rows.Count, 1).End(xlUp).Row
ligne = 4
With FinTabl
    If .Caption = "FinTabl" Then
        .Caption = "Ligne " & ligne
        Cells(DerLin + 1, 1).Select
    Else:
    .Caption = "FinTabl"
    Cells(ligne, 1).Select
End If
End With

Faites un test, et vous verrez que le nom du bouton changera selon le clic effectué.
NB : Si vous voulez vous pouvez changer le nom du code voir le nom du bouton. Dites-moi

apres transfert de ListView vers la feuille "Releve"; colonnes "D","E", et "F", des cellules se formatent en Texte.

En attendant votre retour je regarde ce point

Le 16/11/2024 à 08:37

Bonjour Dan

J'ai faits les changements : c marche sauf lorsque je changes l'ancienne Private Sub ComboBox1_Change(), par la nouvelle:

Dans Private Sub ComboBox1_Change(), il ya le f dans: Call ListViewFil(f, lastrow)------>Type d'argument By Ref incompatible

Cordialement.

24listview-filtrer-entre-2-dates-et-transfert-vers-feuille161124.xlsm (126.06 Ko)
Le 16/11/2024 à 08:44

Bonjour

c marche sauf lorsque je changes l'ancienne Private Sub ComboBox1_Change(), par la nouvelle:

Logique, vous n'avez pas utilisé le code Private Sub ComboBox1_Change() que je vous ai donné ici au point 2 --> https://forum.excel-pratique.com/s/goto/1226278

D'ailleurs je vois d'autres codes qui ne sont pas modifiés comme je vous ai écrit dans mes posts précédents. A mon avis vous êtes reparti d'un mauvais fichier à un moment d'autant que vous avez toujours les couleurs et les bordures jusque la ligne 10485746 dans les feuilles BD2 et relevé. Bizarre.... vous m'aviez écrit avoir supprimé cela

Faites ceci dans votre fichier --> allez dans l'userform et remplacez tous les codes par ceux dans le fichier joint
Ensuite refaites un test

32codes-userform.txt (4.60 Ko)

Nb : dans votre feuille Releve, le code Private Sub Bouton1_Click() doit être supprimé aussi

Le 16/11/2024 à 11:58

Bonjour Dan

Tout d'abord je m'excuse si j' ai mal suivi une recommandation.

J'ai remplacé les codes du fichier texte et j'ai fait le test il est positif.

Une Grande excuse,suivie d'un grand Merci.

Le 16/11/2024 à 13:49

Re

si j' ai mal suivi une recommandation.

Pas grave

Voyez si d'autres points devraient être regardés ou modifiés lors de l'utilisation
Pour ma part, il n'y a une chose qui pourrait être intéressante, c'est de ne pouvoir utiliser le bouton bleu que si les textbox3, 4 et la combo sont complétées
A vous de voir si intérêt

Si ok comme cela et terminé, pensez à cloturer le fil

Cordialement

Le 16/11/2024 à 18:22

Bonjour tous Lecteurs de ce sujet

NB: Corrections

Veuillez noter sur mon premier post de ce sujet: Dans l'avant dernière ligne, c'est TextBox3 et TextBox4 de l'UserForm pour la saisie des dates Debut et Fin

et non TextBox1 et TextBox2.

Salutations.

Le 16/11/2024 à 18:54

Bonjour

Merci du message. J'ai édité votre premier post

Cordialement

Rechercher des sujets similaires à "filtrer listview entre dates transfert resultat feuille"