Более эффективная подпрограмма

Question

У меня есть следующий код, который создает ссылки на лист сводки на нескольких листах CS. Количество листов CS генерируется на одном главном листе CS с использованием другого модуля кода. Код работает, но очень медленно при создании нескольких листов CS. Как я могу сделать его более эффективным?

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 

Answer 1

прекращая вещи - нет никакой необходимости в УВА

вместо

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 

попробовать

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 

и т.д.

Answer 2

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 

Непрошеным. Я изменил несколько вещей:

• декларировать все переменные Спереди (используйте Option Explicit, установите его в настройках VBE)
• не Select материала, вы можете работать с клетками непосредственно
• если ваш код много взаимодействует с выключенными ячейками. Screenupdating