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