Alleger VBA
b
Bonjour,
j'ai fini mon vba mais lors de mon traitement "controle" cela met beaucoup de temps.
C'est lorsqu'il rempli un tableau que cela ralenti
N'étant pas un pro du vba je demande un petit coup de main
Sub controle()
Dim source As Range
Dim dest As Variant
Dim index_row As Integer
Dim index_row_dest As Integer
Dim op As String
Dim controleur As String
Dim date_controle As Date
Dim numcmd As String
Dim vol As String
Dim mel As String
Dim qtéctrl As Integer
Dim qtémauv As Integer
Dim typdef As String
Dim obs As String
Dim ctrltr As String
Dim ctrlcen As String
Dim mille As String
Dim client As String
Dim filtreclient As String
Sheets("Controle").Select
If Range("A2").Value <> "" Then
Set source = Sheets("Controle").Range("Tableaucontrole")
Set dest = Me.L_controle
dest.Clear
dest.ColumnCount = 14
index_row_dest = 0
For index_row = 1 To source.Rows.Count
date_controle = Format(source.Cells(index_row, 1))
controleur = source.Cells(index_row, 2)
numcmd = source.Cells(index_row, 3)
vol = source.Cells(index_row, 4)
mel = source.Cells(index_row, 5)
op = source.Cells(index_row, 6)
qtéctrl = source.Cells(index_row, 7)
qtémauv = source.Cells(index_row, 8)
typdef = source.Cells(index_row, 9)
obs = source.Cells(index_row, 10)
ctrltr = source.Cells(index_row, 11)
ctrlcen = source.Cells(index_row, 12)
mille = source.Cells(index_row, 13)
client = source.Cells(index_row, 14)
If C_filtreop = "" Or C_filtreop = op Then
If C_filtrevol = "" Or C_filtrevol = vol Then
If C_filtrmel = "" Or C_filtrmel = mel Then
If C_filtreclient = "" Or C_filtreclient = client Then
Dim TblE()
If Me.L_controle.ListCount > 0 Then
TblE = Me.L_controle.Column
n = Me.L_controle.ListCount
ReDim Preserve TblE(0 To 13, 0 To n)
Else
n = 0: ReDim TblE(0 To 13, 0 To n)
End If
TblE(0, n) = date_controle
TblE(1, n) = controleur
TblE(2, n) = numcmd
TblE(3, n) = vol
TblE(4, n) = mel
TblE(5, n) = op
TblE(6, n) = qtéctrl
TblE(7, n) = qtémauv
TblE(8, n) = typdef
TblE(9, n) = obs
TblE(10, n) = ctrltr
TblE(11, n) = ctrlcen
TblE(12, n) = mille
TblE(13, n) = client
Me.L_controle.Column = TblE
End If
End If
End If
End If
index_row_dest = index_row_dest + 1
Next index_row
End If
End Subfichier:
Bonjour,
En admettant que j'aie compris la demande ...
Si le but de ta procédure "controle" est de recopier l’entièreté des données présentes dans la feuille "controle", le plus simple est sans doute de remplacer tout le code de cette Sub par quelque chose comme:
Sub controle()
tablo = Sheets("controle").Range("Tableaucontrole")
Me.L_controle.List = tablo
End Sub... sans oublier de définir la propriété ColumnCount de la ListBox à 14
b
je déclare comment "tableau" en objet?
Re-bonjour,
Un
Dim tablo()devrait faire l'affaire (plus d'Excel sous la main pour l'instant ... à tester, donc)
b
lors de l'execution il me dit incompatibilité de type.
J'ai donc essayé en remplacant tout par ce qu'on a mis dans "tableau"
Sub controle()
Dim source As Range
Dim dest As Variant
Dim index_row As Integer
Dim index_row_dest As Integer
Dim op As String
Dim controleur As String
Dim date_controle As Date
Dim numcmd As String
Dim vol As String
Dim mel As String
Dim qtéctrl As Integer
Dim qtémauv As Integer
Dim typdef As String
Dim obs As String
Dim ctrltr As String
Dim ctrlcen As String
Dim mille As String
Dim client As String
Dim filtreclient As String
'
Dim filtreop_ok As Boolean
Dim filtrevol_ok As Boolean
Dim filtremel_ok As Boolean
Dim filtreclient_ok As Boolean
Dim tableau()
Sheets("Controle").Select
If Range("A2").Value <> "" Then
L_controle.Clear
Me.L_controle.ColumnCount = 14
index_row_dest = 0
For index_row = 1 To Sheets("Controle").Range("Tableaucontrole").Rows.Count
date_controle = Format(Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 1))
controleur = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 2)
numcmd = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 3)
vol = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 4)
mel = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 5)
op = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 6)
qtéctrl = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 7)
qtémauv = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 8)
typdef = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 9)
obs = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 10)
ctrltr = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 11)
ctrlcen = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 12)
mille = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 13)
client = Sheets("Controle").Range("Tableaucontrole").Cells(index_row, 14)
If C_filtreop = "" Or C_filtreop = op Then
If C_filtrevol = "" Or C_filtrevol = vol Then
If C_filtrmel = "" Or C_filtrmel = mel Then
If C_filtreclient = "" Or C_filtreclient = client Then
Dim TblE()
If Me.L_controle.ListCount > 0 Then
TblE = Me.L_controle.Column
n = Me.L_controle.ListCount
ReDim Preserve TblE(0 To 13, 0 To n)
Else
n = 0: ReDim TblE(0 To 13, 0 To n)
End If
TblE(0, n) = date_controle
TblE(1, n) = controleur
TblE(2, n) = numcmd
TblE(3, n) = vol
TblE(4, n) = mel
TblE(5, n) = op
TblE(6, n) = qtéctrl
TblE(7, n) = qtémauv
TblE(8, n) = typdef
TblE(9, n) = obs
TblE(10, n) = ctrltr
TblE(11, n) = ctrlcen
TblE(12, n) = mille
TblE(13, n) = client
Me.L_controle.Column = TblE
End If
End If
End If
End If
index_row_dest = index_row_dest + 1
Next index_row
End If
End Submais toujours aussi long
Salut,
Ceci fonctionne chez moi:
Sub controle()
Dim tablo()
tablo = Sheets("controle").Range("Tableaucontrole").Value
Me.L_controle.List = tablo
End Subb
j'ai fait différemment et ça va cent fois mieux
Sub controle()
Dim source As Range
Dim dest As Variant
Dim index_row As Integer
Dim index_row_dest As Integer
Dim op As String
Dim controleur As String
Dim date_controle As Date
Dim numcmd As String
Dim vol As String
Dim mel As String
Dim qtéctrl As Integer
Dim qtémauv As Integer
Dim typdef As String
Dim obs As String
Dim ctrltr As String
Dim ctrlcen As String
Dim mille As String
Dim client As String
Dim filtreclient As String
'
Dim filtreop_ok As Boolean
Dim filtrevol_ok As Boolean
Dim filtremel_ok As Boolean
Dim filtreclient_ok As Boolean
Dim tableau()
Sheets("Controle").Select
If Range("A2").Value <> "" Then
Set source = Sheets("Controle").Range("Tableaucontrole")
Set dest = Me.L_controle
dest.Clear
dest.ColumnCount = 14
index_row_dest = 0
'on lit la source
For index_row = 1 To source.Rows.Count
date_controle = Format(source.Cells(index_row, 1))
controleur = source.Cells(index_row, 2)
numcmd = source.Cells(index_row, 3)
vol = source.Cells(index_row, 4)
mel = source.Cells(index_row, 5)
op = source.Cells(index_row, 6)
qtéctrl = source.Cells(index_row, 7)
qtémauv = source.Cells(index_row, 8)
typdef = source.Cells(index_row, 9)
obs = source.Cells(index_row, 10)
ctrltr = source.Cells(index_row, 11)
ctrlcen = source.Cells(index_row, 12)
mille = source.Cells(index_row, 13)
client = source.Cells(index_row, 14)
'on test les criteres de selection
filtreop_ok = False
If C_filtreop = "" Or C_filtreop = op Then
filtreop_ok = True
End If
filtrevol_ok = False
If C_filtrevol = "" Or C_filtrevol = vol Then
filtrevol_ok = True
End If
filtremel_ok = False
If C_filtrmel = "" Or C_filtrmel = mel Then
filtremel_ok = True
End If
filtreclient_ok = False
If C_filtreclient = "" Or C_filtreclient = client Then
filtreclient_ok = True
End If
'si tous les criteres sont bon on écrit dans le tableau
If filtreop_ok = True And filtrevol_ok = True And filtremel_ok = True And filtreclient_ok = True Then
dest.AddItem
dest.List(index_row_dest, 0) = date_controle
dest.List(index_row_dest, 1) = controleur
dest.List(index_row_dest, 2) = numcmd
dest.List(index_row_dest, 3) = vol
dest.List(index_row_dest, 4) = mel
dest.List(index_row_dest, 5) = op
dest.List(index_row_dest, 6) = qtéctrl
dest.List(index_row_dest, 7) = qtémauv
dest.List(index_row_dest, 8) = typdef
dest.List(index_row_dest, 9) = obs
'dest.List(index_row_dest, 10) = ctrltr
'dest.List(index_row_dest, 11) = ctrlcen
'dest.List(index_row_dest, 12) = mille
'dest.List(index_row_dest, 13) = client
index_row_dest = index_row_dest + 1
End If
Next index_row
End If
End Subpar contre j'ai mis ces lignes en commentaires car ça bug et je ne sais pas pourquoi
'dest.List(index_row_dest, 10) = ctrltr
'dest.List(index_row_dest, 11) = ctrlcen
'dest.List(index_row_dest, 12) = mille
'dest.List(index_row_dest, 13) = clientil me dit "Erreur : Impossible de définir la propriété List. Index de table de propriétés non valide"