更有效的子程序

时间:2014-09-17 13:23:35

标签: excel vba excel-vba

我有以下代码,可以创建多个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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

停止选择 - 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