Bonjour,
dans l'userform1 la listview1 qui dois charger et colorer sous condition
les 20000 lignes de la Feuil1
mais l'execution et longue"Private Sub InitList(Nom As String, Col&)"
Comment accélérer le chargement de listview1 si vous avez
une solution d'optimisation du code svp merci d'avance
Cordialement
Dim Ctrl As Control
Dim Sh As Object
Dim Lig&, Col&, L&, C&
Private Sub UserForm_Initialize()
Me.Caption = "e;"e;
Me.BackColor = &H80000005
For Each Ctrl In Me.Controls
Select Case Left(Ctrl.Name, 3)
Case "e;Tex"e;
Ctrl.BackColor = &H80000018
Ctrl.Font.Name = "e;Arial Narrow"e;
Ctrl.Font.Size = 14
Ctrl.Font.Bold = True
Ctrl.Height = 24
Case "e;Com"e;
Ctrl.BackColor = &H80000018
Ctrl.Font.Name = "e;Arial Narrow"e;
Ctrl.Font.Size = 14
Ctrl.Font.Bold = True
Ctrl.Height = 24
Case "e;Lab"e;
Ctrl.BackColor = &H80000005
Ctrl.BackStyle = 0
Ctrl.Font.Name = "e;Arial Narrow"e;
Ctrl.Font.Size = 14
Ctrl.Font.Bold = True
Ctrl.TextAlign = 3
Ctrl.Height = 24
Case "e;Lis"e;
Ctrl.LabelEdit = 1
Ctrl.View = lvwReport 'affichage en mode Rapport
Ctrl.Gridlines = True 'affichage d'un quadrillage
Ctrl.FullRowSelect = True 'Sélection des lignes comlètes
Ctrl.LabelEdit = False
Ctrl.BackColor = &H80000005 '&H80000018
' Ctrl.ForeColor = &HFF&
Ctrl.Font.Name = "e;Arial Narrow"e;
Ctrl.Font.Size = 12
Ctrl.Font.Bold = True
Case "e;But"e;
' Ctrl.Font.Name = "e;Arial Narrow"e;
' Ctrl.Font.Size = 12
' Ctrl.Font.Bold = True
Ctrl.Top = 330
End Select
Next Ctrl
Private Sub InitList(Nom As String, Col&)
Dim L&
Dim Nlig&
With ListView1
.ListItems.Clear
For L = 2 To 20000 ' Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row
If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then
.ListItems.Add , , L ' Numero de Ligne
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 1)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(1).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 2)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(2).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 3)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(3).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 4)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(4).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 5)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(5).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 6)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(6).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 7)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 8)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(8).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 9)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(9).ForeColor = vbRed 'vbBlue
End If
.ListItems(.ListItems.Count).ListSubItems.Add , , Sh.Cells(L, 10)
If LCase(Sh.Cells(L, 3)) = LCase("e;Néant"e;) Then
.ListItems(.ListItems.Count).ListSubItems(10).ForeColor = vbRed 'vbBlue
End If
End If
Next
End With
On Error Resume Next
ListView1.ListItems(1).Selected = False
Set ListView1.SelectedItem = Nothing
Button2.Visible = False
Button3.Visible = False
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Lig = Val(ListView1.SelectedItem)
For C = 1 To 10
Controls("e;TextBox"e; & C).Value = Sh.Cells(Lig, C)
Next
Button2.Visible = True
Button3.Visible = True
End Sub
Private Sub ComboBox1_Change()
Col = Val(ComboBox1.Column(1))
End Sub
Private Sub TextBox12_Change()
InitList TextBox12.Value, Col
End Sub
Private Sub TextBox3_Change()
If TextBox3 = "e;Néant"e; Then
TextBox1.ForeColor = vbRed
TextBox2.ForeColor = vbRed
TextBox3.ForeColor = vbRed
TextBox4.ForeColor = vbRed
TextBox5.ForeColor = vbRed
TextBox6.ForeColor = vbRed
TextBox7.ForeColor = vbRed
TextBox8.ForeColor = vbRed
TextBox9.ForeColor = vbRed
TextBox10.ForeColor = vbRed
Else
TextBox1.ForeColor = vbBlack
TextBox2.ForeColor = vbBlack
TextBox3.ForeColor = vbBlack
TextBox4.ForeColor = vbBlack
TextBox5.ForeColor = vbBlack
TextBox6.ForeColor = vbBlack
TextBox7.ForeColor = vbBlack
TextBox8.ForeColor = vbBlack
TextBox9.ForeColor = vbBlack
TextBox10.ForeColor = vbBlack
End If
End Sub
Private Sub BButton1_Click()
For C = 1 To 10
Controls("e;TextBox"e; & C).Value = "e;"e;
Next
ComboBox1.ListIndex = 0
TextBox12.Value = "e;"e;
InitList "e;"e;, 1
End Sub
Private Sub Button1_Click()
Dim Dligne&
Dligne = Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row + 1
For C = 1 To 10
Sh.Cells(Dligne, C) = Controls("e;TextBox"e; & C).Value
Next
BButton1_Click
End Sub
Private Sub Button2_Click()
For C = 1 To 10
Sh.Cells(Lig, C) = Controls("e;TextBox"e; & C).Value
Next
BButton1_Click
End Sub
Private Sub Button3_Click()
Sh.Rows(Lig).Delete
BButton1_Click
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michd
Bonjour, Ce ne sont que des suggestions, je n'ai rien testé. Utilise une copie de ton fichier aux fins de test. Cette procédure pourrait se lire ainsi, quelques lignes de code à adapter. Ce qui est le plus long dans cette procédure, c'est coloré chacun des items et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as près de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les éléments soient en couleur? Tu peux toujours tester la procédure en inhibant la ligne de code responsable de l'application de la couleur et voir si tu gagnes beaucoup de temps. .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue '---------------------------- Private Sub InitList(Nom As String, Col&) Dim Compteur As Long, K As Long Dim T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 2 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then Select Case LCase(Sh.Cells(L, 3)) case is = LCase("e;Néant"e;) Compteur Compteur + 1 .ListItems.Add , , L 'Numero de Ligne .ListItems(Compteur).ListSubItems.Add , , T(L, 1) K = K + 1 .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue End Select End If Next End With '---------------------------- Dans la procédure "Private Sub UserForm_Initialize()" Essaie de définir le plus de caractéristiques des contrôles de l'userform en mode création lorsque cela est possible! MichD
Bonjour,
Ce ne sont que des suggestions, je n'ai rien testé.
Utilise une copie de ton fichier aux fins de test.
Cette procédure pourrait se lire ainsi, quelques lignes de code à adapter.
Ce qui est le plus long dans cette procédure, c'est coloré chacun des items
et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as près
de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les
éléments soient en couleur? Tu peux toujours tester la procédure en inhibant
la ligne de code responsable de l'application de la couleur et voir si tu
gagnes beaucoup de temps.
.ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue
'----------------------------
Private Sub InitList(Nom As String, Col&)
Dim Compteur As Long, K As Long
Dim T As Variant, Nb As Long
'Définir la plage de cellules : ' Sh.Range("e;A"e; &
Rows.Count).End(xlUp).Row
With Sh
'La plage de cellules à adapter
T = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
'Nb = Nombre de cellules dans la plage
Nb = UBound(T, 1)
End With
With ListView1
.ListItems.Clear
For L = 2 To Nb
If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then
Select Case LCase(Sh.Cells(L, 3))
case is = LCase("e;Néant"e;)
Compteur Compteur + 1
.ListItems.Add , , L 'Numero de Ligne
.ListItems(Compteur).ListSubItems.Add , , T(L, 1)
K = K + 1
.ListItems(Compteur).ListSubItems(K).ForeColor = vbRed
'vbBlue
End Select
End If
Next
End With
'----------------------------
Dans la procédure "Private Sub UserForm_Initialize()"
Essaie de définir le plus de caractéristiques des contrôles de l'userform en
mode création lorsque cela est possible!
Bonjour, Ce ne sont que des suggestions, je n'ai rien testé. Utilise une copie de ton fichier aux fins de test. Cette procédure pourrait se lire ainsi, quelques lignes de code à adapter. Ce qui est le plus long dans cette procédure, c'est coloré chacun des items et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as près de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les éléments soient en couleur? Tu peux toujours tester la procédure en inhibant la ligne de code responsable de l'application de la couleur et voir si tu gagnes beaucoup de temps. .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue '---------------------------- Private Sub InitList(Nom As String, Col&) Dim Compteur As Long, K As Long Dim T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 2 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then Select Case LCase(Sh.Cells(L, 3)) case is = LCase("e;Néant"e;) Compteur Compteur + 1 .ListItems.Add , , L 'Numero de Ligne .ListItems(Compteur).ListSubItems.Add , , T(L, 1) K = K + 1 .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue End Select End If Next End With '---------------------------- Dans la procédure "Private Sub UserForm_Initialize()" Essaie de définir le plus de caractéristiques des contrôles de l'userform en mode création lorsque cela est possible! MichD
gortex
Le dimanche 15 Avril 2018 à 15:30 par Michd :
Bonjour, Ce ne sont que des suggestions, je n'ai rien testé. Utilise une copie de ton fichier aux fins de test. Cette procédure pourrait se lire ainsi, quelques lignes de code à adapter. Ce qui est le plus long dans cette procédure, c'est coloré chacun des items et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as près de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les éléments soient en couleur? Tu peux toujours tester la procédure en inhibant la ligne de code responsable de l'application de la couleur et voir si tu gagnes beaucoup de temps. .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue '---------------------------- Private Sub InitList(Nom As String, Col&) Dim Compteur As Long, K As Long Dim T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 2 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then Select Case LCase(Sh.Cells(L, 3)) case is = LCase("e;Néant"e;) Compteur Compteur + 1 .ListItems.Add , , L 'Numero de Ligne .ListItems(Compteur).ListSubItems.Add , , T(L, 1) K = K + 1 .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue End Select End If Next End With '---------------------------- Dans la procédure "Private Sub UserForm_Initialize()" Essaie de définir le plus de caractéristiques des contrôles de l'userform en mode création lorsque cela est possible! MichD
Re Merci pour moi c'est pas la ligne de la colorisation qui rallonge l'execution j'ai teste ta proposition mais ne fonctionne pas voici le fichier teste Cordialement https://www.cjoint.com/c/HDpsHm5zIqQ
Le dimanche 15 Avril 2018 à 15:30 par Michd :
> Bonjour,
>
> Ce ne sont que des suggestions, je n'ai rien testé.
> Utilise une copie de ton fichier aux fins de test.
>
> Cette procédure pourrait se lire ainsi, quelques lignes de code à
> adapter.
> Ce qui est le plus long dans cette procédure, c'est coloré chacun
> des items
> et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as
> près
> de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les
> éléments soient en couleur? Tu peux toujours tester la
> procédure en inhibant
> la ligne de code responsable de l'application de la couleur et voir si tu
> gagnes beaucoup de temps.
> .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue
>
> '----------------------------
> Private Sub InitList(Nom As String, Col&)
> Dim Compteur As Long, K As Long
> Dim T As Variant, Nb As Long
>
> 'Définir la plage de cellules : ' Sh.Range("e;A"e; &
> Rows.Count).End(xlUp).Row
> With Sh
> 'La plage de cellules à adapter
> T = .Range("A2:A" & .Range("A" &
> .Rows.Count).End(xlUp).Row).Value
> 'Nb = Nombre de cellules dans la plage
> Nb = UBound(T, 1)
> End With
>
> With ListView1
> .ListItems.Clear
> For L = 2 To Nb
> If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then
> Select Case LCase(Sh.Cells(L, 3))
> case is = LCase("e;Néant"e;)
> Compteur Compteur + 1
> .ListItems.Add , , L 'Numero de Ligne
> .ListItems(Compteur).ListSubItems.Add , , T(L, 1)
> K = K + 1
> .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed
> 'vbBlue
> End Select
> End If
> Next
> End With
> '----------------------------
>
> Dans la procédure "Private Sub UserForm_Initialize()"
> Essaie de définir le plus de caractéristiques des contrôles
> de l'userform en
> mode création lorsque cela est possible!
>
> MichD
Re
Merci
pour moi c'est pas la ligne de la colorisation qui rallonge l'execution
j'ai teste ta proposition mais ne fonctionne pas
voici le fichier teste
Cordialement
https://www.cjoint.com/c/HDpsHm5zIqQ
Bonjour, Ce ne sont que des suggestions, je n'ai rien testé. Utilise une copie de ton fichier aux fins de test. Cette procédure pourrait se lire ainsi, quelques lignes de code à adapter. Ce qui est le plus long dans cette procédure, c'est coloré chacun des items et il n'y a pas beaucoup de choses que l'on peut faire pour cela. Tu as près de 20 000 lignes sur plusieurs colonnes, est-ce nécessaire que tous les éléments soient en couleur? Tu peux toujours tester la procédure en inhibant la ligne de code responsable de l'application de la couleur et voir si tu gagnes beaucoup de temps. .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue '---------------------------- Private Sub InitList(Nom As String, Col&) Dim Compteur As Long, K As Long Dim T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"e; & Rows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 2 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "e;*"e; Then Select Case LCase(Sh.Cells(L, 3)) case is = LCase("e;Néant"e;) Compteur Compteur + 1 .ListItems.Add , , L 'Numero de Ligne .ListItems(Compteur).ListSubItems.Add , , T(L, 1) K = K + 1 .ListItems(Compteur).ListSubItems(K).ForeColor = vbRed 'vbBlue End Select End If Next End With '---------------------------- Dans la procédure "Private Sub UserForm_Initialize()" Essaie de définir le plus de caractéristiques des contrôles de l'userform en mode création lorsque cela est possible! MichD
Re Merci pour moi c'est pas la ligne de la colorisation qui rallonge l'execution j'ai teste ta proposition mais ne fonctionne pas voici le fichier teste Cordialement https://www.cjoint.com/c/HDpsHm5zIqQ
Michd
Je peux raccourcir la procédure, mais difficilement le temps requis pour mettre en couleur au-delà de 80 000 entrées dans le listview. Si tu montes en mémoire vive qu'une fois le formulaire durant une session de travail et te contentes de le masquer (Hide) au lieu de le décharger de la mémoire vive... Cela est "acceptable". Je ne connais pas de solution à ce problème! '---------------------------------------------------------- Private Sub InitList(Nom As String, Col&) Dim A As Long, T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"eRows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 1 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then For A = 1 To 10 .ListItems.Add , , L .ListItems(L).ListSubItems.Add , , T(L, A) If L Mod 2 = 1 Then .ListItems(L).ListSubItems(A).ForeColor = vbYellow End If Next End If Next End With On Error Resume Next ListView1.ListItems(1).Selected = False Set ListView1.SelectedItem = Nothing Button2.Visible = False Button3.Visible = False End Sub '---------------------------------------------------------- MichD
Je peux raccourcir la procédure, mais difficilement le temps requis pour
mettre en couleur au-delà de
80 000 entrées dans le listview. Si tu montes en mémoire vive qu'une fois le
formulaire durant une session de travail et te contentes de le masquer
(Hide) au lieu de le décharger de la mémoire vive... Cela est "acceptable".
Je ne connais pas de solution à ce problème!
'----------------------------------------------------------
Private Sub InitList(Nom As String, Col&)
Dim A As Long, T As Variant, Nb As Long
'Définir la plage de cellules : ' Sh.Range("e;A"eRows.Count).End(xlUp).Row
With Sh
'La plage de cellules à adapter
T = .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
'Nb = Nombre de cellules dans la plage
Nb = UBound(T, 1)
End With
With ListView1
.ListItems.Clear
For L = 1 To Nb
If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then
For A = 1 To 10
.ListItems.Add , , L
.ListItems(L).ListSubItems.Add , , T(L, A)
If L Mod 2 = 1 Then
.ListItems(L).ListSubItems(A).ForeColor = vbYellow
End If
Next
End If
Next
End With
On Error Resume Next
ListView1.ListItems(1).Selected = False
Set ListView1.SelectedItem = Nothing
Button2.Visible = False
Button3.Visible = False
End Sub
'----------------------------------------------------------
Je peux raccourcir la procédure, mais difficilement le temps requis pour mettre en couleur au-delà de 80 000 entrées dans le listview. Si tu montes en mémoire vive qu'une fois le formulaire durant une session de travail et te contentes de le masquer (Hide) au lieu de le décharger de la mémoire vive... Cela est "acceptable". Je ne connais pas de solution à ce problème! '---------------------------------------------------------- Private Sub InitList(Nom As String, Col&) Dim A As Long, T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"eRows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 1 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then For A = 1 To 10 .ListItems.Add , , L .ListItems(L).ListSubItems.Add , , T(L, A) If L Mod 2 = 1 Then .ListItems(L).ListSubItems(A).ForeColor = vbYellow End If Next End If Next End With On Error Resume Next ListView1.ListItems(1).Selected = False Set ListView1.SelectedItem = Nothing Button2.Visible = False Button3.Visible = False End Sub '---------------------------------------------------------- MichD
gortex
Le lundi 16 Avril 2018 à 00:55 par Michd :
Je peux raccourcir la procédure, mais difficilement le temps requis pour mettre en couleur au-delà de 80 000 entrées dans le listview. Si tu montes en mémoire vive qu'une fois le formulaire durant une session de travail et te contentes de le masquer (Hide) au lieu de le décharger de la mémoire vive... Cela est "acceptable". Je ne connais pas de solution à ce problème! '---------------------------------------------------------- Private Sub InitList(Nom As String, Col&) Dim A As Long, T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"eRows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 1 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then For A = 1 To 10 .ListItems.Add , , L .ListItems(L).ListSubItems.Add , , T(L, A) If L Mod 2 = 1 Then .ListItems(L).ListSubItems(A).ForeColor = vbYellow End If Next End If Next End With On Error Resume Next ListView1.ListItems(1).Selected = False Set ListView1.SelectedItem = Nothing Button2.Visible = False Button3.Visible = False End Sub '---------------------------------------------------------- MichD
Bonsoir ca ne fonctionne pas
Le lundi 16 Avril 2018 à 00:55 par Michd :
> Je peux raccourcir la procédure, mais difficilement le temps requis pour
> mettre en couleur au-delà de
> 80 000 entrées dans le listview. Si tu montes en mémoire vive
> qu'une fois le
> formulaire durant une session de travail et te contentes de le masquer
> (Hide) au lieu de le décharger de la mémoire vive... Cela est
> "acceptable".
> Je ne connais pas de solution à ce problème!
>
> '----------------------------------------------------------
> Private Sub InitList(Nom As String, Col&)
> Dim A As Long, T As Variant, Nb As Long
> 'Définir la plage de cellules : '
> Sh.Range("e;A"eRows.Count).End(xlUp).Row
> With Sh
> 'La plage de cellules à adapter
> T = .Range("A2:J" & .Range("A" &
> .Rows.Count).End(xlUp).Row).Value
> 'Nb = Nombre de cellules dans la plage
> Nb = UBound(T, 1)
> End With
> With ListView1
> .ListItems.Clear
> For L = 1 To Nb
> If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then
> For A = 1 To 10
> .ListItems.Add , , L
> .ListItems(L).ListSubItems.Add , , T(L, A)
> If L Mod 2 = 1 Then
> .ListItems(L).ListSubItems(A).ForeColor = vbYellow
> End If
> Next
> End If
> Next
> End With
> On Error Resume Next
> ListView1.ListItems(1).Selected = False
> Set ListView1.SelectedItem = Nothing
> Button2.Visible = False
> Button3.Visible = False
>
> End Sub
> '----------------------------------------------------------
>
> MichD
Bonsoir
ca ne fonctionne pas
Je peux raccourcir la procédure, mais difficilement le temps requis pour mettre en couleur au-delà de 80 000 entrées dans le listview. Si tu montes en mémoire vive qu'une fois le formulaire durant une session de travail et te contentes de le masquer (Hide) au lieu de le décharger de la mémoire vive... Cela est "acceptable". Je ne connais pas de solution à ce problème! '---------------------------------------------------------- Private Sub InitList(Nom As String, Col&) Dim A As Long, T As Variant, Nb As Long 'Définir la plage de cellules : ' Sh.Range("e;A"eRows.Count).End(xlUp).Row With Sh 'La plage de cellules à adapter T = .Range("A2:J" & .Range("A" & .Rows.Count).End(xlUp).Row).Value 'Nb = Nombre de cellules dans la plage Nb = UBound(T, 1) End With With ListView1 .ListItems.Clear For L = 1 To Nb If UCase(Sh.Cells(L, Col).Text) Like UCase(Nom) & "*" Then For A = 1 To 10 .ListItems.Add , , L .ListItems(L).ListSubItems.Add , , T(L, A) If L Mod 2 = 1 Then .ListItems(L).ListSubItems(A).ForeColor = vbYellow End If Next End If Next End With On Error Resume Next ListView1.ListItems(1).Selected = False Set ListView1.SelectedItem = Nothing Button2.Visible = False Button3.Visible = False End Sub '---------------------------------------------------------- MichD
Bonsoir ca ne fonctionne pas
Michd
| ca ne fonctionne pas Extraordinaire, la précision avec laquelle tu énonces ce qui ne va pas! Est-ce que je dois faire un effort pour répondre à ce type de message? Voici ton fichier : https://www.cjoint.com/c/HDymCDdRSTi MichD
| ca ne fonctionne pas
Extraordinaire, la précision avec laquelle tu énonces ce qui ne va pas!
Est-ce que je dois faire un effort pour répondre à ce type de message?
Voici ton fichier : https://www.cjoint.com/c/HDymCDdRSTi
| ca ne fonctionne pas Extraordinaire, la précision avec laquelle tu énonces ce qui ne va pas! Est-ce que je dois faire un effort pour répondre à ce type de message? Voici ton fichier : https://www.cjoint.com/c/HDymCDdRSTi MichD
