Améliorer la rapidité d'une boucle sur 53 feuilles

Z

zephir94

XLDnaute Impliqué
Bonjour à tous,

Je dois faire le total de 53 feuilles dans une 54 ème sur certaines colonnes.
J'ai donc écris ce code qui marche très bien mais qui reste lent :
VB: 
Sub test()
Dim fg
Dim NN
Dim l
Dim P As Variant
Dim ll
Dim vv
vv = ""
Application.ScreenUpdating = False
NN = Sheets(1).Range("C65536").End(xlUp).Row 'recherche de la dernière ligne vide sur la feuille
For fg = 1 To 53 Step 1
With Sheets(fg)
  If fg = 1 Then ' Si on commence par la feuille 1 on vide la feuille Total
  ' à écrire
  Else
  End If
  For ij = 4 To NN Step 1 ' Boucle pour ce déplacer dans les lignes
If IsNumeric(Val(CStr(Sheets(fg).Range("C" & ij).Value))) = True _
And Sheets(fg).Range("C" & ij).Value <> "" Then
k = Sheets(fg).Range("C" & ij).Value
      For Each P In Array(6, 7, 9, 11, 13, 15, 16, 18, 20, 21, 22) ' Boucle pour ce déplacer dans les colonnes
      vv = Sheets(fg).Range("A" & ij).Offset(0, P).Value
      Sheets(54).Range("A" & ij).Offset(0, P).Value = Sheets(54).Range("A" & ij).Offset(0, P).Value + vv
      ko = Sheets(54).Range("A" & ij).Offset(0, P).Value
      vv = ""
      Next P
  Else ' si la valeur de la Cellule n'est pas une valeur numérique alors je ne fait rien
  End If
  Next ij ' je passe à la ligne suivante
End With ' je ferme mon avec la feuille encours
Next fg ' je passe à la feuille suivante
MsgBox " Fin de la boucle"
Application.ScreenUpdating = True
End Sub
Merci par avance pour vos pistes d'améliorations

Bien cordialement Scoubi
 
Trier par date Trier par votes
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour zephir94
Bonjour le fil,Le Forum

une première question tes feuilles 1 à 53 on toutes le même nombre de lignes
car tu détermines la dernière ligne de chaque feuille a partir de la Feuille Une .
VB: 
 NN = Sheets(1).Range("C65536").End(xlUp).Row
si pas le même nombre de lignes mettre (évite de boucler sur des lignes vides)
VB: 
For fg = 1 To 53 Step 1
With Sheets(fg)
NN = .Range("C65536").End(xlUp).Row 'recherche de la dernière ligne vide sur la feuille
sans fichier dur de reproduire et tester
bonne journée
Amicalement
Jean Marie
 
Vote positif 0 Vote négatif
Z

zephir94

XLDnaute Impliqué
ChTi160 à dit:
Bonjour zephir94
Bonjour le fil,Le Forum

une première question tes feuilles 1 à 53 on toutes le même nombre de lignes
car tu détermines la dernière ligne de chaque feuille a partir de la Feuille Une .
VB: 
 NN = Sheets(1).Range("C65536").End(xlUp).Row
si pas le même nombre de lignes mettre (évite de boucler sur des lignes vides)
VB: 
For fg = 1 To 53 Step 1
With Sheets(fg)
NN = .Range("C65536").End(xlUp).Row 'recherche de la dernière ligne vide sur la feuille
sans fichier dur de reproduire et tester
bonne journée
Amicalement
Jean Marie
Cliquez pour agrandir...
Bonjour,
Merci pour cette réponse .
Oui effectivement pardon pour cet oubli les 53 feuilles sont strictement identiques et comportent des valeurs numériques dans certaines lignes et colonnes.
Le but est de les additionner dans une feuille total
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Zéphir, bonjour le forum,

Je n'ai pas compris l'intérêt des variables non déclarées k et ko et je ne suis pas sûr que ce que je te propose soit plus rapide car au final tu boucles 11 x 53 fois...
Code: 
Public Sub Macro1()
Application.ScreenUpdating = False
DL = Sheets(1).Range("C" & Application.Rows.Count).End(xlUp).Row
For Each COL In Array(6, 7, 9, 11, 13, 15, 16, 18, 20, 21, 22)
    For LI = 4 To DL
        T = 0
        For O = 1 To 53
            T = Sheets(O).Cells(LI, COL) + T
        Next O
        Sheets(54).Cells(A, LI) = T
    Next LI
Next COL
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour a tous et toutes lol
Bon toujours en aveugle
VB: 
Sub test()
Dim fg As Byte
Dim NN As Long
Dim P As Variant
Application.ScreenUpdating = False
NN = Sheets(1).Range("C65536").End(xlUp).Row 'recherche de la dernière ligne vide sur la feuille
For fg = 1 To 53 Step 1
With Sheets(fg)
  If fg = 1 Then ' Si on commence par la feuille 1 on vide la feuille Total
     .Range(.Cells(1, 4), .Cells(NN, 22)).ClearContents 'On efface la plage ainsi definie (pas d'info sur le nombre de lignes ou colonnes du Tableau a effacer)
Else
  End If
  For ij = 4 To NN Step 1 ' Boucle pour ce déplacer dans les lignes
   With .Range("C" & ij)
        If IsNumeric(Val(CStr(.Value))) _
                          And .Value <> "" Then
           For Each P In Array(6, 7, 9, 11, 13, 15, 16, 18, 20, 21, 22) ' Boucle pour ce déplacer dans les colonnes
   Sheets(54).Range("A" & ij).Offset(0, P).Value = Sheets(54).Range("A" & ij).Offset(0, P).Value + .Offset(0, P).Value
           Next P
        End If
   End With
  Next ij ' je passe à la ligne suivante
End With ' je ferme mon avec la feuille encours
Next fg ' je passe à la feuille suivante
MsgBox " Fin de la boucle"
Application.ScreenUpdating = True
End Sub
pas évident !!!!!!!!
Essais de mettre un classeur avec deux ou trois feuilles avec quelques lignes de données représentatives de ce que tu as et de ce que tu veux
Bonne journée
Amicalement
Jean marie
 
Vote positif 0 Vote négatif
chris

chris

XLDnaute Barbatruc
Bonjour

Marche en formule 3D mais additionne bien les 53 feuilles ce qui ne donne pas le même résultat que ta macro qui donne le total d'une feuille...

Edit : ta macro contrôle le contenu de la cellule de la colonne C : comme seule 1 feuille a une colonne C remplie, ceci explique cela
 

Pièces jointes

  • Classeur2.xlsm
    246.3 KB · Affichages: 43
Dernière édition:
Vote positif 0 Vote négatif
T

thebenoit59

XLDnaute Accro
Bonjour tout le monde.
La colonne C a t'elle une importance ?
Car dans ta procédure elle n'apparaît pas.

Une solution :

VB: 
Option Explicit

Sub Consolidation_Classeur()
'Déclarations des variables.
'Les tableaux.
Dim t(), temp()
'Les lignes et colonnes.
Dim i&, ii&, j&, jj&
'Les onglets.
Dim n%

    'On se place sur la feuille "Total"
    With Sheets(54)
        'On détermine la taille du Tableau final.
        ii = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        jj = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        'On enregistre le tableau en l'état actuel.
        ReDim t(1 To ii, 1 To jj)
    End With

    'On boucle les Feuilles 1 à 53.
    For n = 1 To 53
        'On se place dans la Feuille.
        With Sheets(n)
            'On crée le tableau temporaire.
            'Selon les dimensions du tableau final.
            temp = .Range(.Cells(1, 1), .Cells(ii, jj)).Value
                'On va boucler les tableaux.
                Call Somme_Tableau(t(), temp(), n)
        End With
    Next n

    'On reporte le tableau final.
    With Sheets(54)
        With .Range(.Cells(1, 1), .Cells(ii, jj))
            .ClearContents
            .Value = t
        End With
    End With

End Sub

Sub Somme_Tableau(Tableau1(), Tableau2(), Niveau%)
Dim i&, j&, k%
Dim Colonne()
    Colonne = Array(3, 6, 7, 9, 11, 13, 15, 16, 18, 20, 21, 22)
    For i = LBound(Tableau1, 1) To UBound(Tableau1, 1)
        For k = LBound(Colonne) To UBound(Colonne)
            j = Val(Colonne(k))
            If Not IsNumeric(Tableau2(i, j)) And Niveau = 1 Then
                Tableau1(i, j) = Tableau2(i, j)
            ElseIf (Tableau2(i, j)) > 0 Then
                Tableau1(i, j) = Tableau1(i, j) + Tableau2(i, j)
            End If
        Next k, i
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Z

zephir94

XLDnaute Impliqué
Merci Chris,
Je viens de voir ton fichier et j'ai corrigé le mien où j'avais oublié de reproduire la colonne C ! voilà pourquoi je n'avais qu'une feuille de compté !

Peux tu m'en dire un peu plus sur :
Code: 
=SOMME(Feuil1:Feuil53!F4)
je ne comprend pas F4 vue que cette formule est en G4 ?
Merci pour vos aides à tous
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
896
thivame
T
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
63
Latias
L
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
94
sebastien176
S
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
203
Compte Supprimé 979
C
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
180
Dranreb
Dranreb
Regueiro
  • Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
282
sylvanu
sylvanu
D
  • Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
321
dadu35
D
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
225
Zonmé
Z
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
145
Francky79
F
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
141
eric72
E

Membres actuellement en ligne

10 membres et 124 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 115
Messages
2 085 443
Membres
102 889
dernier inscrit
monsef JABBOUR