XL 2013 améliorons cette boucle et la déclarations des variables :)

Luc St-laurent · 3 Septembre 2020

Bonjour à tous,

Le code ci-dessous roule bien mais il n'est vraiment pas élégant et il est loin d'être optimal.
Est-ce que vous auriez des idées pour améliorer l'exécution et la rapidité de celui-ci.

merci

VB:

Option Explicit

Sub Boucle()

Dim r As Long, m As Integer, mm As Variant, n As Integer, mmArray As Variant, nr As Integer, mct As Integer, i As Integer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


    m = Range("B8")
    r = 26 + m
    nr = 1



    mmArray = Array(1, 4, 8, 15, 22, 26, 27, 32, 44, 77)

        For Each mm In mmArray
            mct = 1


    ThisWorkbook.Activate
        Sheet1.Select
        Range("B1").Select
            ActiveCell.FormulaR1C1 = "='[chiffres.xlsx]MM@" & mm & "'!R" & r & "C6"
        
        Range("B2").Select
            ActiveCell.FormulaR1C1 = "='[chiffres.xlsx]MM@" & mm & "'!R" & r & "C10"
        
'Clear
    
        ActiveSheet.Range("R2:R" & Range("R2").End(xlDown).Row).ClearContents
    
'Copier et transposer l'historique.
    
            Windows("chiffres.xlsx").Activate
                Sheets("MM@" & mm & "").Select
                    Range("A1").Select
                ActiveCell.Offset(25 + m, 13 + mm).Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
    ThisWorkbook.Activate 'Transposer
        Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("R1").Select
    
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

    
'**********
Macro2
'**********

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

        
' Copier Coller

                For i = 1 To 4

                        Sheet1.Select ' Copier
                                Range("A1").Select
                                ActiveCell.Offset(9 + i, 1).Range("A1:J1").Select
                                Selection.Copy
    
                        Sheet13.Select ' Coller
                                Range("A1").Select
                                ActiveCell.Offset(7 + nr, 2 + mct).Range("A1").Select
                
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
                            SkipBlanks:=False, Transpose:=False
            
                    mct = mct + 16 ' Offset de 16 vers la droite pour le prochain
    
                Next i
                
         nr = nr + 1
        
 Next mm
 
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

soan · 3 Septembre 2020

Rectificatif n° 2 : pour ton post #7, j'ai zappé :
«
Mon objectif est de simplement copier la section B11:K11 et ensuite
B:12:K12 suivi de B13:K13 et finalement B14:K14
»
Or avec cet objectif, la boucle For i devient :

Code:

    For i = 1 To 4 '4 Copier/Coller
      Cells(10 + i, 2).Resize(, 10).Copy 'Copier
      Sheet13.[A1].Offset(7 + nr, 2 + mct).PasteSpecial -4163, 4 'Coller
      mct = mct + 16 'Offset de 16 vers la droite pour le prochain
    Next i

soan

soan · 3 Septembre 2020

@Luc St-laurent

Je te laisse lire mes 2 posts précédents, puis celui-ci.

Pour : nbr = Range("S2") - 1: Range("S2") =COUNT(R2:R10000)

mets à la place :

nbr = [S2] - 1: [S2] = WorksheetFunction.CountA([R2:R10000])

--------------------------------------------------------------------------

Et si tu veux le faire pour toute la colonne R :

nbr = [S2] - 1: [S2] = WorksheetFunction.CountA(Columns(18))

soan

XL 2013 améliorons cette boucle et la déclarations des variables :)

Luc St-laurent

XLDnaute Nouveau

soan

soan

XLDnaute Barbatruc

Discussions similaires