Autres Problème de compréhension macro

JPaul13 · 8 Mai 2020

Bonjour à Tous les membres du club

Comme évoqué hier en fin cette nuit je suis nouveau et je vais vous présenter un problème que je souhaiterai résoudre et sur lequel je but depuis plusieurs semaines.
Actuellement mon code fonctionne très bien ; il s'agit de transférer les données d'une feuille excel du même classeur vers ma listview de mon USERFORM mode plein écran.
Le soucis est que lorsque je transfert plus 5000 lignes sur 15 colonnes j'ai un ralentissement ce qui est très gênant au visuel car on retrouve l'arrière plan de mon excel.

voici mon code actuel sur 8 colonnes qui peut être à besoin d’être corrigé

Private Sub Userform_Initialize() 'Mise a jour Listview
Dim I As Long
With ListView1
With .ColumnHeaders 'titre de la colonne et largeur et alignement
.Clear
.Add , , "PK", 40
.Add , , "Traverse", 40
.Add , , "Rail", 30
.Add , , "Tracé", 30
.Add , , "Devers", 40
.Add , , "Profil", 30
.Add , , "Caténaires", 45
.Add , , "Val Dég", 35
End With
With Me
.Zoom = 100 * (Application.Height / Me.Height)
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True

For I = 2 To Sheets.[_Default]("Sheet1").Range("A65536").End(xlUp).Row
.ListItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 1)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 2)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 3)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 4)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 5)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 6)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 7)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 8)
If Sheets.[_Default]("Sheet1").Cells(1, 20) = 0 Or Sheets.[_Default]("Sheet1").Cells(I, 8) < Sheets.[_Default]("Sheet1").Cells(1, 20) Then
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &H80000008 ' Couleur Bleu
Else
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &HFF& 'Couleur Rouge
End If
TextBox3.Value = ThisWorkbook.Sheets("Sheet1").Range("T1")
Next
End With
End Sub

Maintenant en fouillant sur le net j'ai trouvé un code qui apparemment réduit considérablement les exécutions de transfert, mais je n'arrive pas à l'adapter à mon code.
Code présenté tel quel , les libélés (Lib A) et quantités sont bien évidement à adapté à mon codage.

Sub Methode_B()
Dim monForm As New UserForm1
Dim i As Long
Dim mesValeurs(99, 4) As Variant
For i = 0 To 99
mesValeurs(i, 0) = i 'on inscrit par exemple un identifiant unique de ligne
mesValeurs(i, 1) = "lib_A_" & i 'on inscrit le libellé de 1ère colonne
mesValeurs(i, 2) = "lib_B_" & i 'on inscrit le libellé de 2ème colonne
mesValeurs(i, 3) = "lib_C_" & i 'on inscrit le libellé de 3ème colonne
mesValeurs(i, 4) = "lib_D_" & i 'on inscrit le libellé de 4ème colonne
Next i
monForm.ListBox1.List = mesValeurs 'on charge les valeurs en une fois dans le contrôle ListBox1
monForm.Show
End Sub

Je pense avoir été assez clair et attend avec impatience vos commentaires et encore mieux une ou des réponses.
Vous remerciant par avance

jmfmarques · 8 Mai 2020

Bonjour
L'évènement initialize est à déconseiller vivement pour gérer les aspects graphiques. Lors de cet évènement, les contrôles graphiques sont encore en cours de chargement.
utiliser l'évènement Activate.

ps : ce qui ne veut pas dire, loin de là, que je trouve bonne l'idée de l'utilisation d'une listview qui n'est pas un contrôle natif de VBA et posera donc, tôt ou tard, des problèmes de portabilité.

eriiic · 8 Mai 2020

Bonjour à tous,

En plus de la remarque de jfmarques, l'exemple que tu as adapté n'était pas pour une colonne unique ?
~~Il me semble qu'il n'y a pas d'autre méthode que .Add pour un listview multi-colonnes.~~
Edit : Oupss, je n'avais pas vu listbox..., sorry
Edit 2 : ah mais je n'avais pas rêvé, tu as un listview que tu cherches à utiliser comme un listbox...
Décide-toi, ce n'est pas pareil

Si tu vas sur un listbox :

VB:

ListBox1.List() = Range("A1:D5000").Value

Et si tu ajoutes Application.ScreenUpdating = false en 1èle ligne du code ça donne quoi ?
eric

fanch55 · 8 Mai 2020

Salut,
La comparaison n'est pas pertinente, listview et listbox sont deux objets différents .
La source de la listview est une Table structurée ?
C'est un choix délibéré d'avoir pris une Listview ?

mapomme · 8 Mai 2020

Bonjour @JPaul13, bienvenue dur XLD

,

Voir une piste dans le fichier avec la propriété RowSource:

VB:

Private Sub UserForm_Initialize()
Dim DerLig&

   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      DerLig = .Cells(.Rows.Count, "b").End(xlUp).Row
      ListBox1.ColumnCount = 15
      ListBox1.RowSource = .Range("b2").Resize(DerLig - 1, 15).Address
      ListBox1.ColumnHeads = True
   End With
End Sub

Nonjour @fanch55

fanch55 à dit:
La comparaison n'est pas pertinente, listview et listbox sont deux objets différents .
La source de la listview est une Table structurée ?

Comme d 'hab. et c'est de plus en plus fréquent, aucun fichier fourni : Pas de bras, pas de chocolat.
De toute façon, je n'utilise pas de ListView par principe. On a déjà une feuille de calcul (avec MFC possibles, formats des nombres, couleurs des fonds et des polices et toutes les possibilités natives d'Excel). Pourquoi aller recréer un tableur minimaliste qui fait doublon ? Et je ne parle pas des PB de version que j'ai déjà rencontrés.

fanch55 · 8 Mai 2020

Ah d'accord, le listview c'est pour pouvoir colorier certaines cellules ....

eriiic · 8 Mai 2020

Re,

j'avais oublié la ligne de titre qui ne va pas avec .list
Utilise .RowSource proposé par mapomme
eric

fanch55 · 8 Mai 2020

Bon, on me dira que j'ai que ça à foutr... ( c'est vrai !!! )

J'ai testé avec une table de même dimension que la votre .
Ma dernière utilisation des listviews date de Vb6 .

Excel 64 bits, 16 go de ram , un vieux cpu intel Quad core mais avec une pêche d'enfer .
Listview : 1,7 secondes
Listbox : moins d'une seconde .
Et tout celà sans "scintellement" .

Pour vérifier, j'ai testé sur un portable avec 4go et un Cpu amd e-je ne me souviens plus.
J'ai pleuré : près de 4 secondes pour le listview , et 2 sd pour le listbox et beaucoup de "rafraichissement écran", même en faisant des hide .

Bref, votre code ne peut être mieux optimisé mais dépend de l'architecture du système .

La listbox fait mieux , ce n'est pas étonnant, elle travaille "en bloc de masse" avec le code adéquat, la listview se laisse construire ...

Après y'a plus plus tout le "confort" du Listview qui se résume en "afficher les headers" et colorier certaines cellules .

Voilà, c'est juste une question de goûts et de couleurs .... tant que le listview fonctionne .

Nota: je n'ai jamais réussi à faire de rowsource avec un listview, mais je suis prêt à savoir comment .

JPaul13 · 9 Mai 2020

Wahoo !!

Je n'attendais pas autant de réponses aussi rapides; je tiens déjà a vous remercier.
Je vais tester les différentes méthodes proposé et adapter tout çà.

Effectivement je n'ai pas joint de fichiers car c'était la première fois que je postais une demande.
Le choix de la listview est du fait que sur une autre macro non présenté je peux faire ressortir des valeurs hors tolérances en code couleur selon valeur d'un textbox.

Dans tous les cas je vais avancer et je vous soumettrez mon fichier.

Encore Merci de votre collaboration

JPaul13 · 9 Mai 2020

eriiiic à dit:
Bonjour à tous,

En plus de la remarque de jfmarques, l'exemple que tu as adapté n'était pas pour une colonne unique ?
~~Il me semble qu'il n'y a pas d'autre méthode que .Add pour un listview multi-colonnes.~~
Edit : Oupss, je n'avais pas vu listbox..., sorry
Edit 2 : ah mais je n'avais pas rêvé, tu as un listview que tu cherches à utiliser comme un listbox...
Décide-toi, ce n'est pas pareil

Si tu vas sur un listbox :

VB:

ListBox1.List() = Range("A1:D5000").Value

Et si tu ajoutes Application.ScreenUpdating = false en 1èle ligne du code ça donne quoi ?
eric

Bonjour Eric

Je te répond directement car effectivement mon code fonctionne pour une listbox, et j'ai trouvé sur internet un modelé de code qui lui est établi pour une listbox et je voulais savoir si ce code pouvait être exécuté avec modifs approprié vers une listbox; mais je vais essayer tes propositions et quand j'aurai avancé un peu plus je vous transfert mes fichiers.

bien à toi

eriiic · 9 Mai 2020

Bonjour,

tiens compte de mon post #7
eric

fanch55 · 9 Mai 2020

Re-bonjour le Fil .

fanch55 à dit:
Bon, on me dira que j'ai que ça à foutr... ( c'est vrai !!! )

Pour être dans la continuité,
Je me suis donc focalisé sur le ListBox :

Pas mal, 50 000 lignes en 13 centièmes de secondes.

Je me suis même planté à un moment en générant plus de 500 000 lignes :

Waoow, 522 882 lignes en 20 centièmes de secondes !!!!!
C'est plus rapide de générer cet userform et d'y naviguer que dans la Feuille ...( fichier de 50 mo
quand même ... )

Le code pour l'Userform est archi simple :
1 listbox, 1 label

VB:

Option Explicit
Dim T As Single
Private Sub UserForm_Activate()
Dim Table       As ListObject
Dim W_Columns   As String
Dim Cell        As Range
 
   '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
   ' c'est là où on indique quel est le tableau concerné
    Set Table = [T_BDDTECHNIQUE].ListObject
   '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
   
   ' on s'adapte à la largeur des colonnes sources
   ' pas tout à fait vrai, dépend des polices
    For Each Cell In Table.HeaderRowRange.Cells
        W_Columns = Trim(W_Columns & Cell.Width & ";")
    Next
   
    With Me.ListBox1
        .ColumnCount = Table.Range.Columns.Count
        .ColumnWidths = W_Columns ' sinon pas de scrollbar horizontale
        .ColumnHeads = True
        .RowSource = Table.DataBodyRange.Address
    End With
   
    Me.Label1 = Table.Range.Columns.Count & " colonnes , " & _
                Table.Range.Rows.Count & " lignes " & _
                "en " & Format(Timer - T, "#0.00") & " secondes"

End Sub
Private Sub UserForm_Initialize()
   
    Me.Hide
    T = Timer
             Me.Move 0, 0, Application.UsableWidth, Application.UsableHeight
      Me.Label1.Move 0, 0, Me.InsideWidth
    Me.ListBox1.Move 5, Me.Label1.Height, Me.InsideWidth - 10, Me.InsideHeight - Me.Label1.Height

End Sub

Je joins le Frm pour ceux que cela intéresse : fonctionne avec tous les tableaux structurés .

JPaul13 · 9 Mai 2020

Bonjour Fanch 55
Félicitation, je dirais même chapeau bas.
Je vais partir sur ton code
Merci

JPaul13 · 9 Mai 2020

Bonsoir Fanch55

J'ai essayé de mettre en place ton code et je n'arrive pas à la lancer.
Je ne suis pas un expert VBa ; j'ai fais un tableau structuré et nommé
j'ai inséré ton code dans ma feuille code userform
Userform avec listbox

Lorsque j’exécute le programme il bloque pour erreur LAbel1 "menbre de méthodes ou données introuvables"

Je ne doute en aucuns cas de ton code, j'ai certainement loupé QQch.

pour infos j'ai fais le test sur un nouveau classeur.

Merci d'avance

fanch55 · 9 Mai 2020

J'avais inclus un contrôle Label1 pour afficher les infos de construction .
Tu n'as pas de Label1 sur ton userform, il faut enlever les codes de celui-ci .
Le fichier joint devrait fonctionner ...

Autres Problème de compréhension macro

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums