Utiliser des tableau en VBA

[DDC]

re-Bonjour
j'ai ecrit un code VBA, qui marche ma fois parfaitement !! mais qui malheureusement se realise qu'au bout de 20 min.des lors j'ai entendu dire la possibilité de travailler sur des tableau au lieu de travailler directement sur les feuille excel (gain de temps).Par contre je n'ai aucune idée de comment cela marche et toute mes tentative on été des echecs, alors je me remet a vous!!
J'ai isoler une portion de code !! et si quelqu'un pouvait appliquer un exemple sur celui ci je lui serait extrement reconnaissant !!

 

[Zon]

Salut,

Rapidement tu peux commencer par stocker tes 4 valeurs dans un tableau pour effectivement écrire qu'une fois dans le classeur .
Par exemple :

Dim T ' à déclarer au debut
Dim I&
redim T(1 to 4,1 to 1)
I=1
'*** CONDITION QUI VA DÉFINIR "repère" *****************
For Each Row In Worksheets("AllData").Cells(1, 1).CurrentRegion.Rows
....
...
Else
redim prerserve T(1 to 4, 1 to I)
Value_domain = Cells(linklin1, 120)
Unit = Cells(linklin1, 121)
Name = Cells(linklin1, 12)
à remplacer par

T(0,i)=Cells(linklin1, 12)
T(1,i) = scade_name
T(2,i) = Cells(linklin1, 120)
T(3,i)=Cells(linklin1, 121)

i=i+1

..*
next row
'Ici on écrit qu'une fois

Workbooks("ICD_Avionique_COM").Sheets("ANA sortie").Range("A" & lignprov).resize(ubound(t,2),4)=transposegrandtab(t) 'Elle est définis la variable Lignprov ??????

end sub
Function TransposeGrandTab(T) 'Zon
'Application.transpose est limité à 5000 et qques éléments jusqu'à XL2002
Dim Temp, I&, J&, Z As Byte, Nb As Byte
On Error Resume Next
Do
Nb = Nb + 1
Z = UBound(T, Nb + 1)
Loop Until Err
If Nb = 1 Then
ReDim Temp(UBound(T), 1 To 1)
For I = LBound(T) To UBound(T)
Temp(I, 1) = T(I)
Next I
Else
ReDim Temp(1 To UBound(T, 2), 1 To UBound(T, 1))
For I = 1 To UBound(T, 2)
For J = 1 To UBound(T, 1)
Temp(I, J) = T(J, I)
Next J
Next I
End If
TransposeGrandTab = Temp
End Function



Avec des données exemple on pourrait peut être même faire un find sur "/CPIOM_G1/" au lieu de faire du cellule par cellule, faire un boucle While ....



A+++