Sous-routine plus efficace

J'ai le code suivant qui crée des liens vers une feuille récapitulative sur plusieurs feuilles CS. Le nombre de feuilles CS est généré à partir d'une feuille maître CS en utilisant un autre module de code. Le code fonctionne mais est très lent lors de la création de plusieurs feuilles CS. Comment pourrais-je le rendre plus efficace?Sous-routine plus efficace

Sub CSrefs() 
' 
' Adds links from Summary Sheet to CS Sheets: 

Dim i As Integer 
Dim iOffset As Integer 

    intCount = ActiveWorkbook.Sheets.Count  'Find total number of workbook sheets 
    intCS1_Index = Sheets("CS1").Index   'CS1 Sheet index 
    intCSCount = intCount - (intCS1_Index - 1) 'Find total number of CS sheets 
    NonCSSheets = intCount - intCSCount   'Find total number of Non-CS sheets 

For i = 1 To intCSCount 'number of sheets 

    iOffset = i + NonCSSheets 
    Sheets("CS" & i).Select 
    Range("B3").Select 
     ActiveCell.Formula = "=SUMMARY!E" & iOffset 
    Range("A6").Select 'Adds hyperlink to Summery Sheet 
     ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet" 
    Range("F8").Select 
     ActiveCell.Formula = "=SUMMARY!F" & iOffset 
    Range("D8").Select 
     ActiveCell.Formula = "=SUMMARY!G" & iOffset 
    Range("B12").Select 
     ActiveCell.Formula = "=SUMMARY!H" & iOffset 
    Range("K19").Select 
     ActiveCell.Formula = "=SUMMARY!S" & iOffset 
    Range("K49").Select 
     ActiveCell.Formula = "=SUMMARY!T" & iOffset 
    Range("K79").Select 
     ActiveCell.Formula = "=SUMMARY!U" & iOffset 
    Range("K109").Select 
     ActiveCell.Formula = "=SUMMARY!V" & iOffset 
    Range("K139").Select 
     ActiveCell.Formula = "=SUMMARY!W" & iOffset 
    Range("K169").Select 
     ActiveCell.Formula = "=SUMMARY!X" & iOffset 
    Range("B8").Select 

Next i 

Sheets("Summary").Select 

End Sub

Source

2014-09-17 Paul_S

Créer des feuilles est un processus lent, mais vous n'avez pas besoin de toutes les sélections, ce qui vous aidera. Vous devriez simplement pouvoir utiliser Range ("X #"). Formula = "SUMMARY! X" & iOffset. Cela pourrait réduire légèrement le traitement. De plus, si vous n'activez pas la mise à jour de l'écran, cela ralentira considérablement les choses. Envisagez de mettre fin au livre avec 'Application.ScreenUpdating = false ... Application.ScreenUpdating = true' pour réduire le taux de rafraîchissement, ce qui pourrait aider un peu. – tmoore82

Étant donné que les feuilles de calcul Excel 2007 ont une capacité de 1 048 576 lignes, j'ajouterais que c'est une bonne habitude de déclarer vos variables numériques comme 'Long' et non' Integer'. Un entier assigné à 'Rows.Count' va générer un débordement. – Jeeped

Arrêter les choses de sélection - il n'y a pas besoin en vba

au lieu de

iOffset = i + NonCSSheets 
Sheets("CS" & i).Select 
Range("B3").Select 
    ActiveCell.Formula = "=SUMMARY!E" & iOffset 
Range("A6").Select 'Adds hyperlink to Summery Sheet 
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet" 
Range("F8").Select 
    ActiveCell.Formula = "=SUMMARY!F" & iOffset

essayer

iOffset = i + NonCSSheets 
    with sheets("CS" & i) 
     range("b3").formula = "=SUMMARY!E" & iOffset 
     range("a6").hyperlinks.add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet" 
     range("f8").formula = "=SUMMARY!F" & iOffset 
    end with

etc

Source

2014-09-17 13:34:19

peut être manquant le préfixe. dans les objets 'Range' dans lesquels' With ... End With' et 'Selection' comme' anchor' dans le 'hyperlink' devraient être changés. – Jeeped

Merci à tous. Leçon apprise pour ne pas utiliser Sélectionner –

Sub CSrefs() 
' 
' Adds links from Summary Sheet to CS Sheets: 

Dim i As Integer, iOffset As Integer, intCount as Integer 
Dim intCS1_Index As Integer, intCSCount as Integer, nonCSSheets as Integer 

On Error Goto ErrHandler 

Application.ScreenUpdating = False 

intCount = ActiveWorkbook.Sheets.Count  'Find total number of workbook sheets 
intCS1_Index = Sheets("CS1").Index   'CS1 Sheet index 
intCSCount = intCount - (intCS1_Index - 1) 'Find total number of CS sheets 
NonCSSheets = intCount - intCSCount   'Find total number of Non-CS sheets 

For i = 1 To intCSCount 'number of sheets 
    iOffset = i + NonCSSheets 
    With Sheets("CS" & i) 
     .Range("B3").Formula = "=SUMMARY!E" & iOffset 
     .Range("A6").Hyperlinks.Add Anchor:=.Range("A6"), Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet" 
     .Range("F8").Formula = "=SUMMARY!F" & iOffset 
     .Range("D8").Formula = "=SUMMARY!G" & iOffset 
     .Range("B12").Formula = "=SUMMARY!H" & iOffset 
     .Range("K19").Formula = "=SUMMARY!S" & iOffset 
     .Range("K49").Formula = "=SUMMARY!T" & iOffset 
     .Range("K79").Formula = "=SUMMARY!U" & iOffset 
     .Range("K109").Formula = "=SUMMARY!V" & iOffset 
     .Range("K139").Formula = "=SUMMARY!W" & iOffset 
     .Range("K169").Formula = "=SUMMARY!X" & iOffset 
    End With 
Next i 

Sheets("Summary").Select 

ExitHere: 
    Application.ScreenUpdating = True 
    Exit Sub 

ErrHandler: 
    ' take care of errors here if needed 
    GoTo ExitHere 

End Sub

Non testé. J'ai changé deux choses:

déclarer toutes vos variables à l'avant (utiliser Option Explicit, mettre en place dans les options de VBE)
ne pas Select choses, vous pouvez travailler avec des cellules directement
si votre code interagit beaucoup avec les cellules désactivées Screenupdating

Source

2014-09-17 13:48:05 xificurC

Bon point sur 'Select'. J'aime toujours créer un lien vers [ce fil] (http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) qui explique comment et pourquoi :) –

I Je crois que 'iOffset = i + NonCSSheets' devrait être dans la boucle' For ... Next'. – Jeeped

@Jeeped: très vrai, merci, je l'ai corrigé. – xificurC

Sous-routine plus efficace

Répondre

Questions connexes