Simplification de code VBA

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
S

Softmama

XLDnaute Accro
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
B

bof

XLDnaute Occasionnel
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
iStarOSX

iStarOSX

XLDnaute Junior
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
B

bof

XLDnaute Occasionnel
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
iStarOSX

iStarOSX

XLDnaute Junior
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
B

bof

XLDnaute Occasionnel
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

Discussions similaires

T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
320
Chaton77
Chaton77
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
477
Zonmé
Z
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
453
AtTheOne
AtTheOne
S
  • Résolu(e)
Microsoft 365 Boucle pour afficher et masquer des lignes
Réponses
12
Affichages
447
shf
S
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
691
jebibo
J
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
271
gillesda
G
N
  • Résolu(e)
XL 2021 comment faire recherche dans une colonne et ligne
Réponses
5
Affichages
289
job75
job75
Jojo973
  • Question
Microsoft 365 Trier des données et les afficher sur une autre feuille
Réponses
10
Affichages
318
Jojo973
Jojo973
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
480
Compte Supprimé 979
C

Membres actuellement en ligne

16 membres et 309 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
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh