LISTVIEW TROP LONGUE A CHARGER MA FEUIL

**samchich** · 07/04/2018, 22h47

Bonsoir a tous
ma listview ne arrive pas a charger ma feuil qui contient 60000 lignes

merci d'avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
Private Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Option Compare Text 'Pour ignorer les majuscules ou minuscules
Option Explicit
 
Dim Mem_Code_Art        'pour retrouver ligne excel si modif code art
 
Private Sub Majour_Lsvw_Click()
    'majour listview
    Call Majour_Lvw
End Sub
 
Private Sub TextBox3_Change()
    If TextBox3 = "Néant" Then
        TextBox12.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
        TextBox12.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 TextBox1_Change()
    Dim I As Long
    Dim C As Range
 
    ListView1.ListItems.Clear
    If TextBox1 <> "" Then
        With Sheets("BIBLIOTHEQUE DE PRIX TCE")
            I = 2
            Do
                For Each C In .Range(.Cells(I, 1), .Cells(I, 10))
                    If UCase(CStr(C.Value)) = UCase(TextBox1.Value) Or InStr(CStr(C), TextBox1) > 0 Then
                        IniLvw12 C.Row
                        Exit For
                    End If
                Next C
                I = I + 1
            Loop While .Cells(I, 1) <> ""
        End With
    Else
        Me.TextBox2 = ""
        Me.TextBox3 = ""
        Me.TextBox4 = ""
        Me.TextBox5 = ""
        Me.TextBox6 = ""
        Me.TextBox7 = ""
        Me.TextBox8 = ""
        Me.TextBox9 = ""
        Me.TextBox10 = ""
        Me.TextBox12 = ""       'code art
        Call Majour_Lvw      'majour listview
    End If
End Sub
 
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ListView1.Sorted = False
    ListView1.SortKey = ColumnHeader.Index - 1
    If ListView1.SortOrder = lvwAscending Then
        ListView1.SortOrder = lvwDescending
    Else
        ListView1.SortOrder = lvwAscending
    End If
    ListView1.Sorted = True
    'Unload Me
    'CONSULTATION_PRIX.Show
End Sub
 
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim I As Integer
    Dim J As Integer
 
    Dim x
    I = Me.ListView1.SelectedItem.Index
    TextBox12 = ListView1.ListItems(I)
    Mem_Code_Art = TextBox12.Value
    For J = 1 To Me.ListView1.ColumnHeaders.Count - 1
        Me.Controls("Textbox" & J + 1) = ListView1.ListItems(I).ListSubItems(J).Text
    Next J
  'Unload Me
  'CONSULTATION_PRIX.Show
End Sub
 
Sub IniLvw12(a As Long)
    Dim x
    Dim I
    Dim J
    Dim C
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then
                    .ListItems(I).Bold = True
                    .ListItems(I).ForeColor = vbRed
                    For C = 1 To .ColumnHeaders.Count
                        .ListItems(I).ListSubItems(C).Bold = True
                        .ListItems(I).ListSubItems(C).ForeColor = vbRed     'couleur colonne 2
                    Next C
                End If
            Next J
        Next I
    End With
End Sub
 
Private Sub UserForm_Activate()
    EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
End Sub
 
Private Sub UserForm_Initialize()
    Dim hWnd As Long
    Dim ligne
 
    hWnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
    With Me.ListView1
        With .ColumnHeaders
            .Clear
            .Add , , "Code art.", 70, lvwColumnLeft
            .Add , , "Type Ets", 55, lvwColumnCenter
            .Add , , "Nom Ets (Client)", 95, lvwColumnCenter
            .Add , , "Désignation", 220, lvwColumnCenter
            .Add , , "D.U. (F)", 60, lvwColumnCenter
            .Add , , "D.U. (D/P)", 60, lvwColumnCenter
            .Add , , "D.U. (ST)", 50, lvwColumnCenter
            .Add , , "Unité", 35, lvwColumnCenter
            .Add , , "Qté", 50, lvwColumnCenter
            .Add , , "Sous-traitant", 140, lvwColumnCenter
        End With
        ligne = 1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
    End With
End Sub
 
Sub Majour_Lvw()
    Dim Nbl As Long, I As Long, J As Long, C As Range
 
    ListView1.ListItems.Clear
    'If TextBox12 = "" Then
        With Sheets("BIBLIOTHEQUE DE PRIX TCE")
            I = 2
            J = .Range("A456541").End(xlUp).Row
            For Each C In .Range("A2:A" & .Range("A456541").End(xlUp).Row)
                Call IniLvw_Maj(C.Row)
            Next C
        End With
    'Else
    '    MsgBox "Attention code article vide---------------Majour_Lvw!!!!!!"
    'End If
End Sub
 
Sub IniLvw_Maj(a As Long)
    Dim x
    Dim I
    Dim J
    Dim C
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then
                    .ListItems(I).Bold = True
                    .ListItems(I).ForeColor = vbRed
                    For C = 1 To .ColumnHeaders.Count
                        .ListItems(I).ListSubItems(C).Bold = True
                        .ListItems(I).ListSubItems(C).ForeColor = vbRed     'couleur colonne 2
                    Next C
                End If
            Next J
        Next I
    End With
End Sub

**patricktoulon** · 08/04/2018, 11h36

re
bonjour
60000 lignes c'est lourd quand meme c'est donc un peu normal
j'ai cependant suprimer une sous bouclede colonne dans la boucle ligne donc (60000*9 )boucles inutiles ca peut arranger un peu les choses

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub IniLvw_Maj(a As Long)
    Dim x, I, J, C, coul, B
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            .ListItems(I).Bold = .ListItems(I) = TextBox1
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then B = True: coul = vbRed Else B = False: coul = vbBlack
                .ListItems(I).Bold = B
                .ListItems(I).ForeColor = coul
                .ListItems(I).ListSubItems(J).Bold = B
                .ListItems(I).ListSubItems(J).ForeColor = coul     'couleur colonne 2
            Next C
        End If
    Next J
Next I
End With
End Sub

apres il y aurais pas mal a en dire mais il me faut un fichier en exemple avec au moins la feuilles de reference et ce userform

pour ce genre de grosse base de donnée il y a Access qui est plus performant et certainement plus approprié

**samchich** · 08/04/2018, 14h18

Envoyé par patricktoulon

re
bonjour
60000 lignes c'est lourd quand meme c'est donc un peu normal
j'ai cependant suprimer une sous bouclede colonne dans la boucle ligne donc (60000*9 )boucles inutiles ca peut arranger un peu les choses

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub IniLvw_Maj(a As Long)
    Dim x, I, J, C, coul, B
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            .ListItems(I).Bold = .ListItems(I) = TextBox1
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then B = True: coul = vbRed Else B = False: coul = vbBlack
                .ListItems(I).Bold = B
                .ListItems(I).ForeColor = coul
                .ListItems(I).ListSubItems(J).Bold = B
                .ListItems(I).ListSubItems(J).ForeColor = coul     'couleur colonne 2
            Next C
        End If
    Next J
Next I
End With
End Sub

apres il y aurais pas mal a en dire mais il me faut un fichier en exemple avec au moins la feuilles de reference et ce userform

pour ce genre de grosse base de donnée il y a Access qui est plus performant et certainement plus approprié

Re merci
Ta modif ne fonction pas
je joint le fichier
merci d'avance

**patricktoulon** · 08/04/2018, 15h12

re
8.40 minute listview toujours pas affichée
sans concession on oublie excel préférer access

si tu tiens a continuer avec excel, il t'es pas venu a l'idée que tu pouvait faire sans listview??? histoire de laisser ta pauvre Ram souffler un peu ainsi que ton procc

EDIT:
et meme sans interface avec des autofilter c'est lourd je viens de faire quelque test avec tes 27xxx lignes
ma reponse est définitive et catégorique a savoir ("excel on oublie")

**samchich** · 08/04/2018, 15h42

Envoyé par patricktoulon

re
8.40 minute listview toujours pas affichée
sans concession on oublie excel préférer access

si tu tiens a continuer avec excel, il t'es pas venu a l'idée que tu pouvait faire sans listview??? histoire de laisser ta pauvre Ram souffler un peu ainsi que ton procc

Merci pour ta patience
si listbox mais je souhaite colorer les ligne qui contienne le mot néant
si tu vois une solution de ce coté la
merci d'avance

**patricktoulon** · 08/04/2018, 15h58

oui une simple MFC sur les cellules avec "neant"
mais je te le redis
pas la peine de continuer sur cette voie "excel on oublie" tu va droit dans le mur

LISTVIEW TROP LONGUE A CHARGER MA FEUIL

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager