procedure trop grande

[BIL boud]

Bonjour,

jai mis un code (modif de code de ODVJ) qui est très long , du coup a l'excution de cet dernier jai un message d'erreur "procedure trop grande"

je ne sais pas comment y proceder sachant que le code est une repetition identique avec une petite modification au niveau de range

le code que jai mis est disponible dans le fichier joint (module 1)

merci d'avance

 

[bof]

Bonjour,
Le traitement ne prend que quelques secondes, mais quand tu auras toutes les feuilles et toutes les lignes il est possible que cette macro soit un peu lente...
Il est possible de l'accélérer un peu en modifiant la macro :

Sub Galopin()
Dim ArrN, ArrT, Tablo, iR%, Ws%, iLR%, kC%, iCR%, iCC%, iVC%, SVC$
iR = ActiveCell.Row  'Cette variable emporaire sera abandonnée et réutilisée plus loin
SVC = Cells(RTAB(iR), 1).Value   'Lit la valeur dans le tableau RTAB
iCR = (iR - 1) Mod 6             'N° de la ligne dans le tableau (A:E)
iCC = ActiveCell.Column - 1
iVC = TDIS(iCR, iCC)          'Lit dans le tableau la valeur cherchée
iLR = 2
ArrT = Range("H1:M1").Value   'Mémorise les en-têtes
Application.ScreenUpdating = False  'Ligne à insérer
Columns("H:M").ClearContents
Range("H1:M1") = ArrT         'rétablit les en-têtes
Tablo = Range("H1:M100").Value      'Charge un tableau vide
ArrN = Application.Transpose(Worksheets("NEW_VB_config").[O2:O12])
For iR = 2 To 3000
   For Ws = 1 To 11
      If ArrN(Ws) <> "" Then
         With Worksheets(ArrN(Ws))
            If .Range("AO" & iR).Value <> "" Then  'On ne lit que les lignes non vide
               'Les conditions : 'ligne doit comporter l'en-tête du tableau
               'Et dans la colonne AO on cherche iVC à la position iCC
               If .Range("A" & iR) = SVC And _
                  Mid(.Cells(iR, 41), iCC, 1) = iVC Then
                  Select Case iCR
                  Case 1 To 4
                     For kC = 1 To 6
                        Tablo(iLR, kC) = .Cells(iR, kC) 'on écrit dans le Tablo
                     Next
                  End Select
               iLR = iLR + 1     'On incrémente le N° de la ligne d'écriture
               End If
            End If
         End With
      End If
   Next Ws
Next iR
Range("H1:M100") = Tablo   'On décharge le Tablo dans la feuille !
End Sub

A+

 

[BIL boud]

Bonjour,
Le traitement ne prend que quelques secondes, mais quand tu auras toutes les feuilles et toutes les lignes il est possible que cette macro soit un peu lente...
Il est possible de l'accélérer un peu en modifiant la macro :

Sub Galopin()
Dim ArrN, ArrT, Tablo, iR%, Ws%, iLR%, kC%, iCR%, iCC%, iVC%, SVC$
iR = ActiveCell.Row  'Cette variable emporaire sera abandonnée et réutilisée plus loin
SVC = Cells(RTAB(iR), 1).Value   'Lit la valeur dans le tableau RTAB
iCR = (iR - 1) Mod 6             'N° de la ligne dans le tableau (A:E)
iCC = ActiveCell.Column - 1
iVC = TDIS(iCR, iCC)          'Lit dans le tableau la valeur cherchée
iLR = 2
ArrT = Range("H1:M1").Value   'Mémorise les en-têtes
Application.ScreenUpdating = False  'Ligne à insérer
Columns("H:M").ClearContents
Range("H1:M1") = ArrT         'rétablit les en-têtes
Tablo = Range("H1:M100").Value      'Charge un tableau vide
ArrN = Application.Transpose(Worksheets("NEW_VB_config").[O2:O12])
For iR = 2 To 3000
   For Ws = 1 To 11
      If ArrN(Ws) <> "" Then
         With Worksheets(ArrN(Ws))
            If .Range("AO" & iR).Value <> "" Then  'On ne lit que les lignes non vide
               'Les conditions : 'ligne doit comporter l'en-tête du tableau
               'Et dans la colonne AO on cherche iVC à la position iCC
               If .Range("A" & iR) = SVC And _
                  Mid(.Cells(iR, 41), iCC, 1) = iVC Then
                  Select Case iCR
                  Case 1 To 4
                     For kC = 1 To 6
                        Tablo(iLR, kC) = .Cells(iR, kC) 'on écrit dans le Tablo
                     Next
                  End Select
               iLR = iLR + 1     'On incrémente le N° de la ligne d'écriture
               End If
            End If
         End With
      End If
   Next Ws
Next iR
Range("H1:M100") = Tablo   'On décharge le Tablo dans la feuille !
End Sub

A+

Bonjour

merci pour le code
je vais le modifier chez moi

bonne journée