Simplification de code VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion iStarOSX
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
iStarOSX

iStarOSX

XLDnaute Junior
Bonsoir a tous les Exeliens.

Voila j'ai fais une application qui fonctionne enfin, mais voila j'ai une macro qui est lourde a l'exécution.

Normal je suis l'oing d'être un pro de VBA, je bidouille seulement !!!

Si quelq'un pouvait m'aider a ameliorer mon code, ce serait sympa.

Voici mon (Long) code :
Code: 
Sub Transfert_Radiateurs_Temp()
    
    If Sheets("Catalogue").Range("A1") > 0 And Sheets("Catalogue").Range("I3") > 0 Then  'condition pour executer la macro

Application.ScreenUpdating = False

'Déprotège la feuille :
Sheets("Catalogue").Unprotect "chau"
Sheets("Radiateurs du Projet").Unprotect "chau"
'Déprotège le classeur :
ActiveWorkbook.Unprotect "chau"


' Désactive les filtres automatique
If Worksheets("Catalogue").AutoFilterMode Then
     Worksheets("Catalogue").AutoFilterMode = False
End If

Sheets("Radiateurs du Projet").Range("D1") = 1

'Rend visible la feuille de transfert temporaire :
Sheets("Rad_Temp").Visible = True

'Efface les données de la plage de destination :
    Sheets("Rad_Temp").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

Dim L1%, I%, J% ' variable    %= as integer
L1 = 26 ' num de ligne
Do ' boucle
    Select Case Sheets("Catalogue").Range("b" & L1).Value ' selon valeur Qté
        Case 0, "", " "
            I = 0
        Case 1
            I = 1
        Case Is > 1
            I = Sheets("Catalogue").Range("b" & L1).Value
        
        
    End Select
    For J = 1 To I 'seconde boucle pour le transfert

'Transfert dans Rad_Temp les données radiateurs :
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(1, 0) = Sheets("Catalogue").Range("b" & L1).Value

        
        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 1 To 11
            .Offset(0, I) = Sheets("Catalogue").Cells(L1, 3 + I) ' "e" est la cinquième colonne
            Next I
        End With


        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 12 To 25
            .Offset(0, I) = Sheets("Catalogue").Cells(L1, 4 + I) ' "e" est la cinquième colonne
            Next I
        End With

        
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 28) = Sheets("Catalogue").Range("ad" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 29) = Sheets("Catalogue").Range("ae" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 30) = Sheets("Catalogue").Range("af" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 31) = Sheets("Catalogue").Range("ag" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 32) = Sheets("Catalogue").Range("ah" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 33) = Sheets("Catalogue").Range("ai" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 34) = Sheets("Catalogue").Range("aj" & L1).Value
        
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 35) = Sheets("Catalogue").Range("ak" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 36) = Sheets("Catalogue").Range("al" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 37) = Sheets("Catalogue").Range("am" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 38) = Sheets("Catalogue").Range("an" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 39) = Sheets("Catalogue").Range("ao" & L1).Value
      Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 40) = Sheets("Catalogue").Range("ap" & L1).Value
        
        
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 42) = Sheets("Catalogue").Range("aq" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 43) = Sheets("Catalogue").Range("ar" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 44) = Sheets("Catalogue").Range("as" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 45) = Sheets("Catalogue").Range("at" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 46) = Sheets("Catalogue").Range("au" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 47) = Sheets("Catalogue").Range("av" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 48) = Sheets("Catalogue").Range("aW" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 49) = Sheets("Catalogue").Range("ax" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 50) = Sheets("Catalogue").Range("ay" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 51) = Sheets("Catalogue").Range("aZ" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 52) = Sheets("Catalogue").Range("BA" & L1).Value
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 53) = Sheets("Catalogue").Range("BB" & L1).Value
        
        
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 54) = Sheets("Catalogue").Range("BC" & L1).Value
        
        
        
'Insertion des formules

        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 55) = "=IF(OR(AND(RC[-29]=RC[-13],AND(RC[-6]<>"""",RC[-6]<>0)),RC[-29]<>RC[-13]),""Valide"",""Non Valide"")"

        
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 65) = "=IF(COUNTIF(Rad_Projet_NomLocal,RC[-76]) >0, RC[-77]& "" : ""&RC[-76])"
        
        

        
         With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 66 To 95
           .Offset(0, I) = "=RC[-76]*1" ' "e" est la cinquième colonne
            Next I
        End With
        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 77 To 79
           .Offset(0, I) = "=RC[-76]" ' "e" est la cinquième colonne
            Next I
        End With
        
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 95) = "=RC[-76]"
        
        
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 87) = "=RC[-76]/1000"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 96) = "=RC[-70]"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 97) = "=IF(OR(RC[-70]="""",RC[-70]=0),0,1)"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 98) = "=RC[-70]"


        
        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 99 To 103
           .Offset(0, I) = "=IF(RC[-70]=""-"",0,RC[-70])" ' "e" est la cinquième colonne
            Next I
        End With


        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 104 To 105
           .Offset(0, I) = "=RC[-62]" ' "e" est la cinquième colonne
            Next I
        End With

        
        With Sheets("Rad_Temp").Range("m65536").End(xlUp)
            For I = 106 To 110
           .Offset(0, I) = "=IF(RC[-62]=""-"",0,RC[-62])" ' "e" est la cinquième colonne
            Next I
        End With

Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 111) = "=IF(OR(RC[-62]="""",RC[-62]=0),0,1)"


Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 112) = "=RC[-61]*1"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 113) = Sheets("Catalogue").Range("BA" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 114) = Sheets("Catalogue").Range("C" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 116) = Sheets("Catalogue").Range("BB" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 117) = Sheets("Catalogue").Range("BC" & L1).Value

Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 118) = "=IF(OR(AND(OR(AND(RC[-22]=5,RC[-14]=7,RC[-9]=R6C131),AND(RC[-22]=5,RC[-14]=6,(RC[-17]-RC[-9])=R6C131)),RC[-7]=0),AND(OR(AND(RC[-22]=6,RC[-14]=6,(RC[-16]+RC[-9])=R6C131),AND(RC[-22]=5,RC[-14]=5,(RC[-17]+RC[-10])=R6C131)),RC[-7]>0)),1,0)"

Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 119) = Sheets("Catalogue").Range("BD" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 120) = Sheets("Catalogue").Range("BE" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 121) = "=IF(RC[-2]=""Robinetterie integrée du fabricant de radiateur"",RC[-4],""Rxl_""&SUBSTITUTE(RC[-2],"" "",""_"")&"".csv"")"
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 122) = "=""Rxl_""&SUBSTITUTE(RC[-2],"" "",""_"")&"".csv"""

'Transfert dans Rad_Temp les données du local :

    Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, -12) = "1"
        
        With Sheets("Rad_Temp").Range("a65536").End(xlUp)
            For I = 1 To 5
            .Offset(0, I) = Sheets("Catalogue").Cells(3, 4 + I) ' "e" est la cinquième colonne
            Next I
            End With
        
        
        With Sheets("Rad_Temp").Range("a65536").End(xlUp)
            For I = 1 To 5
            .Offset(0, 5 + I) = Sheets("Catalogue").Cells(6, 5 + I) ' "e" est la cinquième colonne
            Next I
            End With

        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, -1) = Sheets("Catalogue").Range("L6").Value
              
         'hateur sous Rad
        Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 115) = Sheets("Catalogue").Range("M6").Value


    Next
    L1 = L1 + 1
Loop Until Sheets("Catalogue").Range("D" & L1).Value = "" ' sortie de la boucle do

'Valide numérotation radiateur
NumRad

Sheets("Rad_Temp").Activate

Sheets("Radiateurs du Projet").Outline.ShowLevels RowLevels:=2

Transfert_Radiateurs_Projet

'Efface les quantités dans le catalogue :
    Sheets("Catalogue").Range("B26:B65536").ClearContents

'Fait passer a l'édition du local suivant :
    Sheets("Catalogue").Range("A3") = Sheets("Catalogue").Range("B3").Value + 1
    
    
'Efface les données de la plage de destination :
    Sheets("Rad_Temp").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
       
'Rend Invisible la feuille de transfert temporaire :
Sheets("Rad_Temp").Visible = False

Sheets("Radiateurs du Projet").Range("D1") = 0

'Remet les filtres AUTO
    Sheets("Catalogue").Range("A25:AZ25").AutoFilter
  
'Protège la feuille :
Sheets("Catalogue").Protect "chau", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFiltering:=True
        
Sheets("Radiateurs du Projet").Protect "chau", DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFiltering:=True
        
ActiveSheet.EnableSelection = xlNoRestrictions
  
  'Protège le classeur :
  ActiveWorkbook.Protect "chau", Structure:=True, Windows:=False
  
    
 Application.ScreenUpdating = True
    
 End If
 
    Sheets("Catalogue").Select
    Range("B26").Select

End Sub

Code: 
Sub NumRad()
Dim Cellule As Range
Dim Nomfeuille1 As String, Nomfeuille2 As String
Dim Col As String
Dim LigDep1 As Long, LigDep2 As Long

'parametre
Nomfeuille1 = "Catalogue"
Nomfeuille2 = "Rad_Temp"
'à modifier
LigDep1 = 26
LigDep2 = 2
Col = "b"

'
With Sheets(Nomfeuille1)
For Each Cellule In .Range(Col & LigDep2 & ":" & Col & Sheets(Nomfeuille2).Range(Col & .Rows.Count).End(xlUp).Row)
    Sheets(Nomfeuille2).Range("a" & LigDep2) = "'" & .Range("B3") & "-" & Sheets(Nomfeuille2).Range("dw" & LigDep2) & "-" & .Range("D15") + LigDep2 - 1
    
    LigDep2 = LigDep2 + 1
Next Cellule

End With
End Sub


Code: 
Sub Transfert_Radiateurs_Projet()


If Sheets("Catalogue").Range("A1").Value = 1 Then


'Crée la liste de racc "Entrée"
Sheets("Rad_Temp").Select
Range("AM2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=AG2:AL2"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    

'Crée la liste de racc "Sortie"
Sheets("Rad_Temp").Select
Range("BC2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=AV2:BB2"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    

ValeurDefautRacc
    

'Transfert vers Radiateurs projet :
    Sheets("Rad_Temp").Select
    Range("2:2").Select
    Selection.Copy
    
    Sheets("Radiateurs du Projet").Select
    Application.GoTo Reference:="R65536C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    
End If

If Sheets("Catalogue").Range("A1").Value > 1 Then

'Crée les listes de racc "Entrée"
    Sheets("Rad_Temp").Select
    Range("AM2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=AG2:AL2"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.Copy
    Range("M65536").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 26).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    
 'Crée les listes de racc "Sortie"
        Sheets("Rad_Temp").Select
        Range("BC2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=AV2:BB2"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Selection.Copy
    Range("M65536").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 42).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    

ValeurDefautRacc


    Application.GoTo Reference:="R65536C1"
    Selection.End(xlUp).Select
    Range(Selection, Selection.End(xlUp)).EntireRow.Copy
    
    Sheets("Radiateurs du Projet").Select
    Application.GoTo Reference:="R65536C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    
'Remet les filtres AUTO
    Sheets("Radiateurs du Projet").Range("A6:BN6").AutoFilter
    
    Sheets("Rad_Temp").Select
    Rows("1:1").Select
    Selection.EntireRow.Hidden = False
    
    Sheets("Catalogue").Select
    Range("B26").Select
End If
End Sub

Code: 
Sub ValeurDefautRacc()
'Entre les valeurs de raccordements par défaut :
    Sheets("Rad_Temp").Range("M65536").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 26).Range("A1").Activate
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FormulaR1C1 = "=RC[8]"
    
    Sheets("Rad_Temp").Range("M65536").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, 42).Range("A1").Activate
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FormulaR1C1 = "=RC[8]"
End Sub


Merci d'avance pour l'aide !!!

Bonne soirée
 
Trier par date Trier par votes
Re : Simplification de code VBA

Ton code est principalement ralentit par les .Select que tu places un peu partout et qui sont complètement inutiles : tu peux toujours dans ton cas gérer les actions sur les objets concernés, sans avoir à les sélectionner. PAr exemple, pour effacer les cellules de la feuille Rad_Temp, tu peux remplacer :
VB: 
    Sheets("Rad_Temp").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
par :
VB: 
   Sheets("Rad_Temp").Cells.Clear
ou encoore remplacer :
VB: 
    Sheets("Rad_Temp").Select
    Range("2:2").Select
    Selection.Copy
   
    Sheets("Radiateurs du Projet").Select
    Application.GoTo Reference:="R65536C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
par :
VB: 
    Sheets("Rad_Temp").Range("2:2").Copy Destination:=Sheets("Radiateurs du Projet").Range("A65536").end(xlup).Offset(1, 0)

ce qui est beaucoup, beaucoup plus rapide.
A adapter pour tous les .Select qui parsèment ton code.

Par ailleurs,
iStarOSX à dit:
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 28) = Sheets("Catalogue").Range("ad" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 29) = Sheets("Catalogue").Range("ae" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 30) = Sheets("Catalogue").Range("af" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 31) = Sheets("Catalogue").Range("ag" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 32) = Sheets("Catalogue").Range("ah" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 33) = Sheets("Catalogue").Range("ai" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 34) = Sheets("Catalogue").Range("aj" & L1).Value

Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 35) = Sheets("Catalogue").Range("ak" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 36) = Sheets("Catalogue").Range("al" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 37) = Sheets("Catalogue").Range("am" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 38) = Sheets("Catalogue").Range("an" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 39) = Sheets("Catalogue").Range("ao" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 40) = Sheets("Catalogue").Range("ap" & L1).Value


Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 42) = Sheets("Catalogue").Range("aq" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 43) = Sheets("Catalogue").Range("ar" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 44) = Sheets("Catalogue").Range("as" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 45) = Sheets("Catalogue").Range("at" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 46) = Sheets("Catalogue").Range("au" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 47) = Sheets("Catalogue").Range("av" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 48) = Sheets("Catalogue").Range("aW" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 49) = Sheets("Catalogue").Range("ax" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 50) = Sheets("Catalogue").Range("ay" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 51) = Sheets("Catalogue").Range("aZ" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 52) = Sheets("Catalogue").Range("BA" & L1).Value
Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 53) = Sheets("Catalogue").Range("BB" & L1).Value


Sheets("Rad_Temp").Range("m65536").End(xlUp).Offset(0, 54) = Sheets("Catalogue").Range("BC" & L1).Value
Cliquez pour agrandir...

peut être remplacé par
VB: 
with Sheets("Rad_Temp").Range("m65536").End(xlUp)
  For t= 28 to 54
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
end With

Bon courage.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Simplification de code VBA

Softmama à dit:
peut être remplacé par
VB: 
with Sheets("Rad_Temp").Range("m65536").End(xlUp)
  For t= 28 to 54
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
end With
Cliquez pour agrandir...
Bonjour,
Cette dernière affirmation doit être corrigée car il y a "un trou" dans la continuité (41)
Il faut donc écrire :
Code: 
  For t= 28 to 40
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
  For t= 42 to 54
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t

A+
 
Vote positif 0 Vote négatif
Re : Simplification de code VBA

Bonjour Softmama et Bof et merci beaucoup pour votre aide.

J'ai modifier comme me la conseillé Softmama tout mes "Select", cela a certainement ameliorer mon code même si a l'exécution de la macro ce n'est pas significatif.

Par contre j'ai testé le code que Bof ma conseillé :
Code: 
with Sheets("Rad_Temp").Range("m65536").End(xlUp)
For t= 28 to 40
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
  For t= 42 to 54
    .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
End With

Ainsi que le code de Softmama :
Code: 
with Sheets("Rad_Temp").Range("m65536").End(xlUp)
  For t= 28 to 54
    if t<> 41 then .offset(, t) = Sheets("Catalogue").cells(L1, 28+t)
  next t
end With

Mais cela a pour effet de faire disparaitre des données et décaler des colonnes !!!

Mais je ne vois pas pourquoi ?

En tous cas merci encore de votre aide
 
Vote positif 0 Vote négatif
Re : Simplification de code VBA

Bonjour,
Ma suggestion visait essentiellement à mettre en évidence une erreur grossière liée à l'interruption à l'Offset 41, mais je n'ai pas vérifié la pertinence du reste du code... Il semble en effet que ce soit erronné.
Essaie quelque chose comme :
Code: 
with Sheets("Rad_Temp").Range("m65536").End(xlUp)
 For t= 28 to 40
     .offset(, t) = Sheets("Catalogue").cells(L1, t+2)
   next t
   For t= 41 to 53
     .offset(, t+1) = Sheets("Catalogue").cells(L1, t+2)
   next t
 End With
Nota : Ta question visait une simplication du code, Les modifications suggérées traitent essentiellement de cette question.
Si ton souçi est d'améliorer le temps d'exécution, de nombreuses autres modifications peuvent sans doute être apportées :
Passage en recalcul manuel au début de la boucle Do...Loop et Recalcul automatique juste avant le tansfert.
Suppression des "Sheets("Rad_Temp").Range("m65536").End(xlUp)" et variabilisation de la "VarRow" concernée pour éviter un recalcul à chaque boucle Do...Loop
Suppression de tous les Offset et adressage "direct" à partir de la variable obtenue :
Code: 
For t= 28 to 40
      .offset(, t) = ...
Next
c'est :
Code: 
For t= 28 to 40
Sheets("Rad_Temp").Cells(VarRow, 13+t)
Next
Enfin selon le nombre de lignes concernées, il serait sans doute possible de remplacer toutes les formules par des formules nommées, cela peut-être particulièrement impressionnant surtout si tu dois traiter plusieurs centaines voire milliers de lignes, mais cela ne me semble possible qu'en disposant des classeurs concernés.


A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Simplification de code VBA

Bonsoir bof

J'ai testé de passer en recalcul manuel au début de macro et effectivement cela améliore grandement la vitesse d'execution.

Pour ce qui est de ton code, je testerais cela demain, car je doit d'abord corriger une partie de mon appli pour la rendre compatible avec excel 2007 et 2010 car je me suis aperçus que mon fichier générer des erreurs lorsque l'on l'utilise sous les dernières version d'excel.

Quand a ta solution avec "VarRow" :
Je doit déclarer cette variable en début de macro ?

Et pourquoi "13+t" ?

Encore merci pour ta précieuse aide.
 
Vote positif 0 Vote négatif
Re : Simplification de code VBA

Bonsoir,
C'est une habitude communément admise de déclarer les variables en début de procédure et non au milieu du code...
Tu auras donc une variables VarRow que tu récupèreras tout de suite après le Do :
VarRow = Sheets("Rad_Temp").Range("M65536").End(xlUp).Row
Ensuite au lieu de travailler tes transferts en offset tu écriras directement les adresses en dur.
Pourquoi 13 + t ?
Parce que la plupart de tes Offset se faisaient à partir de la colonne M qui est la 13ème.
Ok ?
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

U
  • Question Question
Autres Quelques fois ça bug feuilles cachées
Réponses
2
Affichages
169
cathodique
cathodique
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
348
patricktoulon
patricktoulon
Electron24
  • Résolu(e)
Microsoft 365 Virgules dans ListView
Réponses
5
Affichages
352
Electron24
Electron24
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
507
un internaute
U
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
700
TooFatBoy
TooFatBoy
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
613
AtTheOne
AtTheOne
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
648
thunder23
thunder23
anthoYS
  • Résolu(e)
XL 2019 colorer les différents aliments avec un code VB pour macro de ce genre ?
2
Réponses
16
Affichages
238
anthoYS
anthoYS
M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
314
MOLY_
M
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
671
Oneida
Oneida
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
917
spike29
S
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
575
kiki29
kiki29
anthoYS
  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
71
anthoYS
anthoYS
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
567
un internaute
U
T
  • Question Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
2 K
thivame
T
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
459
Abi23
A
N
  • Question Question
Microsoft 365 gestion de kilometrage
Réponses
4
Affichages
241
nabilexcel2007
N
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
957
tnion
T
S
  • Résolu(e)
Microsoft 365 VBA Concaténer contenu de plusieurs cellules dans une seule avec séparateurs / évolutifs
Réponses
3
Affichages
455
spike29
S
Retour