更高效的子程序

我有以下代码创build链接到多个CS表上汇总表。 CS页面的数量是由一个CS主页面使用另一个代码模块生成的。代码工作正常,但是在创build多个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 

 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 

未经testing。 我改变了一些东西:

  • 首先声明所有variables(使用Option Explicit ,在VBE选项中设置它)
  • 不要Select东西,你可以直接使用单元格
  • 如果您的代码与单元格交互很多,则closuresScreenupdating

停止select东西 – 没有必要在vba中

代替

  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 

等等