VBA : Amélioration macro
Bonjour au forum,
Je souhaite améliorer le code d'une macro pour résoudre deux problèmes :
- dans le code ci-dessous : je souhaiterais remplacer "ReDim Preserve mytab2(65000, 6) par quelque chose du genre ReDim Preserve mytab2(a, 6) avec a le nombre de ligne qui varie. Cependant, il semblerait que redim preserve ne modifie que la dernière dimension du tableau, donc si quelqu'un a une idée, peut-être avec (ReDim Preserve mytab2(6,a) puis un transpose mais je bloque?
-lorque je supprime tous les "OUI" (colonnes "G" et "H" de l'Onglet 1), le code provoque une erreur, à cause de la taille du tableau.
Je joins le fichier avec les explications.
Option Base 1
Sub macrotest()
'BY Ketamacanna 15/02/11
Dim mytab1() As Variant, mytab2() As Variant, last_ligne1 As Long, last_ligne2 As Long, ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Onglet 1")
Set ws2 = Worksheets("Onglet 2")
last_ligne1 = ws1.Cells(65000, 1).End(xlUp).Row
last_ligne2 = ws2.Cells(65000, 1).End(xlUp).Row
If last_ligne1 = 1 Then Exit Sub
mytab1() = ws1.Range("A2:H" & last_ligne1)
borne_dim1 = UBound(mytab1, 1)
borne_dim2 = UBound(mytab1, 2)
For i = 1 To borne_dim1
If mytab1(i, 7) = "OUI" Or mytab1(i, 8) = "OUI" Then
a = a + 1
For j = 1 To 6
ReDim Preserve mytab2(65000, 6)
mytab2(a, j) = mytab1(i, j)
Next j
Else
End If
Next i
Range("J2:O30") = mytab2
Erase mytab1, mytab2
End Sub
Merci à ceux qui pourront se pencher sur ce problème.
Bonne journée
Bonjour
A essayer
A améliorer
Option Base 1
Sub macrotest()
'BY Ketamacanna 15/02/11
Dim Mytab1() As Variant, last_ligne1 As Long, last_ligne2 As Long, ws1 As Worksheet, ws2 As Worksheet
Dim Mytab2()
Dim I As Integer
Dim J As Integer
Set ws1 = Worksheets("Onglet 1")
Set ws2 = Worksheets("Onglet 2")
last_ligne1 = ws1.Cells(65000, 1).End(xlUp).Row
last_ligne2 = ws2.Cells(65000, 1).End(xlUp).Row
If last_ligne1 = 1 Then Exit Sub
Mytab1() = ws1.Range("A2:H" & last_ligne1)
ReDim Mytab2(1 To 6, 1)
'borne_dim1 = UBound(Mytab1, 1)
borne_dim2 = UBound(Mytab1, 2)
For I = 1 To UBound(Mytab1)
If Mytab1(I, 7) = "OUI" Or Mytab1(I, 8) = "OUI" Then
For J = 1 To 6
Mytab2(J, UBound(Mytab2, 2)) = Mytab1(I, J)
Next J
ReDim Preserve Mytab2(6, UBound(Mytab2, 2) + 1)
End If
Next I
If UBound(Mytab2, 2) = 1 Then Exit Sub
ReDim Mytab1(UBound(Mytab2, 2) - 1, 6)
For I = 1 To UBound(Mytab2, 2) - 1
For J = 1 To 6
Mytab1(I, J) = Mytab2(J, I)
Next J
Next I
Range("J2:O6").Resize(UBound(Mytab1), 6) = Mytab1
Erase Mytab1, Mytab2
End Sub
Merci pour ce code. C'est impec. Par contre, j'ai testé sur 10000 lignes, et l'ancien code mettait 1 seconde, avec le nouveau, environ 5. Connais-tu la raison ?
Est-il donc plus judicieux de laisser 65000 ? Cela semble plus rapide ? Tu confirmes?
Cordialement
et encore merci Banzai