第13章 Excel开发最佳实践

13.1 取消激活Activate以及不选择Select

代码清单13.1 避免使用选择和选区

 

'代码清单13.1 避免使用选择和选区

Sub RecorderCode()
    Sheets("Sheet1").Select
    Columns("A:A").Select
    Selection.Font.Bold = True
    
    Sheets("Sheet2").Select
    Columns("B:B").Select
    Selection.Font.Bold = True
    
    Sheets("Sheet3").Select
    Columns("C:D").Select
    Selection.Font.Bold = True
    Range("A1").Select
    
    Sheets("Sheet4").Select
    Columns("D:D").Select
    Selection.Font.Bold = True
    Range("A1").Select
    
End Sub

'A more efficient version of recorderCode
Sub RecorderCodeII()
    With ThisWorkbook
        .Worksheets("Sheet1").Range("A:A").Font.Bold = True
        .Worksheets("Sheet2").Range("B:B").Font.Bold = True
        .Worksheets("Sheet3").Range("C:C").Font.Bold = True
        .Worksheets("Sheet4").Range("D:D").Font.Bold = True
        
    End With

End Sub

Sub TestProcedures()
    Dim dResult As Double
    
    dResult = TestProcedure(1, True)
    Debug.Print "RecorderCode w/screen updating: " & Format(dResult, "0.00") & " seconds."

    dResult = TestProcedure(2, True)
    Debug.Print "RecorderCodeII w/screen updating: " & Format(dResult, "0.00") & " seconds."
    
    dResult = TestProcedure(1, False)
    Debug.Print "RecorderCode w/o screen updating: " & Format(dResult, "0.00") & " seconds."

    dResult = TestProcedure(2, False)
    Debug.Print "RecorderCodeII w/o screen updating: " & Format(dResult, "0.00") & " seconds."
    
End Sub

Function TestProcedure(nVersion As Integer, bScreenUpdating As Boolean) As Double
    Dim nRepetition As Integer
    Dim ws As Worksheet
    Dim dStart As Double
    
    'set screen updating
    Application.ScreenUpdating = bScreenUpdating
    
    'record the start time
    dStart = Timer
    
    'loop through procedure 100 times
    For nreptition = 1 To 100
        If nVersion = 1 Then
            RecorderCode
        Else
            RecorderCodeII
        End If
    Next
    
    'return elapsed time since procedure started
    TestProcedure = Timer - dStart
    
    'make sure ScreenUpdating is on
    Application.ScreenUpdating = True
    
    Set ws = Nothing
    
End Function

 

 

13.2 管理显示

13.3 可移植设计

13.4 在跳水之前先试试水温

13.5 记住数学

13.6 像环保者那样思考

13.7 小心使用文字数据

代码清单13.2：使用Evaluate方法获取存储工作薄名称的数据

 

'代码清单13.2: 使用Evaluate方法获取存储工作薄名称的数据
Sub TestWorkbookNameValue()
    Dim vValue As Variant
    
    vValue = Application.Names("SalesTaxRate").RefersTo
    Debug.Print "Value retrieved using Value: " & vValue
    
    vValue = Application.Names("SalesTaxRate").Value
    Debug.Print "Value retrieved using Value: " & vValue
    
    'this next line doesnt work because the name
    'doesn't refer to a range. intentionally commented out.
    vValue = Application.Names("SalesTaxRate").RefersToRange
    
    vValue = Application.Evaluate("SalesTaxRate")
    Debug.Print "Value retrieved using Evaluate: " & vValue
    
End Sub

 

 

代码清单13.3：使用VBA注册表函数处理注册表

 

'代码清单13.3: 使用VBA注册表函数处理注册表
Sub ExperimentWithRegistry()
    Dim vaKeys As Variant
    
    'create new registry entries
    
    SaveSetting "XLTest", "General", "App_Name", "XLTest"
    SaveSetting "XLTest", "General", "App_Version", "1.0.0"
    SaveSetting "XLTest", "General", "App_Date", "10/11/2003"
    
    PrintRegistrySettings
    
    'get all settings in an array
    vaKeys = GetAllSettings("XLTset", "Genaral")
    PrintAllSettings vaKeys
    
    DeleteSetting "XLTest", "General", "App_Name"
    DeleteSetting "XLTest", "General", "App_Version"
    DeleteSetting "XLTest", "General", "App_Date"
    
    PrintRegistrySettings
End Sub

Sub PrintRegistrySettings()
    On Error Resume Next
    
    Debug.Print "Application Name: " & Getseting("XLTest", "General", "App_Name")
    Debug.Print "Application Version: " & Getseting("XLTest", "General", "App_Version")
    Debug.Print "Application Date: " & Getseting("XLTest", "General", "App_Date")
    
    Debug.Print "-----------------------------------------"
    
End Sub

Sub PrintAllSettings(vaSettings As Variant)
    Dim nItem As Integer
    
    If IsArray(vaSettings) Then
        For nItem = 0 To UBound(vaSettings)
            Debug.Print vaSettings(nItem, 0) & ": " & vaSettings(nItem, 1)
        Next
    End If
        
    Debug.Print "-----------------------------------------"
        
End Sub

 

 

13.8 巧妙的工作薄设计