Création VBA Excel

Le 03/07/2024 à 09:27

Bonjour, je cherche sur Excel à réaliser une macro qui permette de copier-coller les valeurs d'un grand nombre de plages simultanément afin de rompre les formules qui permettaient de trouver les données présentes dans ces plages. Je suis parvenu à un code, cependant, le souci est que l'exécution du code est très longue, car Excel copie et colle les plages une par une et non simultanément. Si quelqu'un a une solution au problème, je suis preneur. Je mets en lien le code auquel je suis parvenu jusqu'à présent.

Sub OptimiserCode()
    Dim plages As Variant
    Dim i As Integer

    plages = Array("C12:E13", "C15:E16", "C19:E19", "C22:E23", "C29:E29", "C38:D39", "C41:D42", _
                   "C45:D45", "C48:D49", "C55:D55", "F38:H39", "F41:H42", "F45:H45", "F48:H49", _
                   "F55:H55", "J38:L39", "J41:L42", "J45:L45", "J48:L49", "J55:L55", "N38:P39", _
                   "N41:P42", "N45:P45", "N48:P49", "N55:P55", "R38:T39", "R41:T42", "R45:T45", _
                   "R48:T49", "R55:T55", "V38:X39", "V41:X42", "V45:X45", "V48:X49", "V55:X55", _
                   "Z38:Z39", "Z41:Z42", "Z45:Z45", "Z48:Z49", "Z55:Z55", "C64:I65", "C67:I69", _
                   "C71:I71", "C74:I75", "C81:I81", "K64:M65", "K67:M68", "K71:M71", "K74:M75", _
                   "K81:M81", "C90:AB91", "C93:AB94", "C97:AB97", "C100:AB101", "C107:AB107", _
                   "C116:D117", "C119:D120", "C123:D123", "C126:D127", "C133:D133", "F116:H117", _
                   "F119:H120", "F123:H123", "F126:H127", "F133:H133")

    Application.ScreenUpdating = False
    For i = LBound(plages) To UBound(plages)
        With ActiveSheet.Range(plages(i))
            .Value = .Value
        End With
    Next i
    Application.ScreenUpdating = True
End Sub
Le 03/07/2024 à 09:48

Bonjour,

Faites une union des plages :

Sub OptimiserCode()
    Dim plages As Variant
    Dim i As Long

    plages = Array("C12:E13", "C15:E16", "C19:E19", "C22:E23", "C29:E29", "C38:D39", "C41:D42", _
                   "C45:D45", "C48:D49", "C55:D55", "F38:H39", "F41:H42", "F45:H45", "F48:H49", _
                   "F55:H55", "J38:L39", "J41:L42", "J45:L45", "J48:L49", "J55:L55", "N38:P39", _
                   "N41:P42", "N45:P45", "N48:P49", "N55:P55", "R38:T39", "R41:T42", "R45:T45", _
                   "R48:T49", "R55:T55", "V38:X39", "V41:X42", "V45:X45", "V48:X49", "V55:X55", _
                   "Z38:Z39", "Z41:Z42", "Z45:Z45", "Z48:Z49", "Z55:Z55", "C64:I65", "C67:I69", _
                   "C71:I71", "C74:I75", "C81:I81", "K64:M65", "K67:M68", "K71:M71", "K74:M75", _
                   "K81:M81", "C90:AB91", "C93:AB94", "C97:AB97", "C100:AB101", "C107:AB107", _
                   "C116:D117", "C119:D120", "C123:D123", "C126:D127", "C133:D133", "F116:H117", _
                   "F119:H120", "F123:H123", "F126:H127", "F133:H133")

    Application.ScreenUpdating = False

    Dim finalRange As Range
    Set finalRange = ActiveSheet.Range(plages(0))
    For i = 1 To UBound(plages)
      Set finalRange = Union(finalRange, ActiveSheet.Range(plages(i)))
    Next i
    finalRange.Value2 = finalRange.Value2

    Application.ScreenUpdating = True
End Sub
Le 03/07/2024 à 11:48

Bonjour à vous,

Sauf si je n'ai pas compris et que la feuille contient d'autres formules qu'on ne veut pas écraser,
pourquoi ne pas faire

    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues

Cordialement

Le 03/07/2024 à 12:37

La question est d'augmenter la vitesse or le copier / coller cellule par cellule prend plus de temps que de changer les valeurs directement.

Le 03/07/2024 à 14:26

J'ai bien compris la question, ma réponse est la méthode plus rapide

Le 03/07/2024 à 18:08

Bonjour Etienne Pernelle, Salut JExcel2fr, Saboh12617

comme ceci ???? (environ 20-30 millisecondes) (égal à Saboh2617)

Sub OptimiserCode1()
     '***************************************
     'première fois = créer la plage nommée "Etienne"
     '***************************************

     Dim plages As Variant, UN As Range, c
     Dim i     As Long
     '     t = Timer
     Application.ScreenUpdating = False
     plages = Array("C12:E13", "C15:E16", "C19:E19", "C22:E23", "C29:E29", "C38:D39", "C41:D42", _
                    "C45:D45", "C48:D49", "C55:D55", "F38:H39", "F41:H42", "F45:H45", "F48:H49", _
                    "F55:H55", "J38:L39", "J41:L42", "J45:L45", "J48:L49", "J55:L55", "N38:P39", _
                    "N41:P42", "N45:P45", "N48:P49", "N55:P55", "R38:T39", "R41:T42", "R45:T45", _
                    "R48:T49", "R55:T55", "V38:X39", "V41:X42", "V45:X45", "V48:X49", "V55:X55", _
                    "Z38:Z39", "Z41:Z42", "Z45:Z45", "Z48:Z49", "Z55:Z55", "C64:I65", "C67:I69", _
                    "C71:I71", "C74:I75", "C81:I81", "K64:M65", "K67:M68", "K71:M71", "K74:M75", _
                    "K81:M81", "C90:AB91", "C93:AB94", "C97:AB97", "C100:AB101", "C107:AB107", _
                    "C116:D117", "C119:D120", "C123:D123", "C126:D127", "C133:D133", "F116:H117", _
                    "F119:H120", "F123:H123", "F126:H127", "F133:H133")

     s = Join(plages, ",")
     Do While Len(s) > 0
          i = IIf(Len(s) < 255, 255, InStrRev(s, ",", 255))
          Set c = Range(Left(s, i - 1))
          Set UN = Union(IIf(UN Is Nothing, c, UN), c)
          s = Mid(s, i + 1)
     Loop

     UN.Name = "Etienne"                     'éventuellement, si plus tard, vous voulez de nouveau faire quelque chose avec cette plage, on peut le faire directement
     UN.Value = Now                          'changer la valeur des cellules
     Application.ScreenUpdating = True
     MsgBox Timer - t
End Sub

Sub OptimiserCode2()
     '*******************************
     'plus tard, un utilise directement "Etienne"
     '*******************************
     t = Timer
     Range("Etienne").Value = Now
     MsgBox Timer - t
End Sub
Rechercher des sujets similaires à "creation vba"