用于处理自定义数据结构的代码合并

Question

我在 MS Project 中开发了一个 VBA 应用程序来衡量项目进度的质量。我的应用程序分析计划中的每项任务并确定 35 个不同的属性，然后以各种方式组合这些属性来计算 13 个不同的质量分数。该程序运行良好并产生正确的结果，但我想将代码合并到各种函数中，这样它就不会冗长（例如，消除 Select Case 语句）。详情如下：

Public Const NoAnalItems As Integer = 35                ' Number of analysis items
'
' Define SA_Array and declare SCHED_ANAL
'
Public Type SA_Array                ' SA = Schedule Analysis
    Item As String                  ' Name of the analysis item
    SAT As Single                   ' Number of tasks for the entire schedule
    SOT As Single                   ' Number of open tasks
    PAT As Single                   ' Number of tasks for the entered period
    POT As Single                   ' Number of open tasks for the entered period
    WT As Integer                   ' Quality score weight
    Category As String              ' Category of the analysis item
    Description As String           ' Decription of the item for display on the help screen
    Risk As String                  ' Risk associated with the item for display on the help screen
    ExecuteCheckbox As CheckBox     ' Pointer to associated analysis item checkbox; TRUE if executed, FALSE if not
    RepairButton As CommandButton   ' Pointer to associated analysis item repair button
End Type
Public SCHED_ANAL(NoAnalItems) As SA_Array


Function qsM(stype)
'
' Title:    qsM
' Author:   11/21/2023 by Gary E. Didio
' Purpose:  Returns the milestone tasks quality score
'           stype is the type of task (all, open, period all, or period open)
'
On Error Resume Next

    Dim qs, qa, qw As Single
    qs = 0
    Dim t As SA_Array

    
    Select Case stype
        Case "SAT": qa = (SCHED_ANAL(pMDurn).SAT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).SAT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).SAT * SCHED_ANAL(pMPred).WT)
                    If (SCHED_ANAL(pMTotl).SAT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).SAT
        
        Case "SOT": qa = (SCHED_ANAL(pMDurn).SOT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).SOT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).SOT * SCHED_ANAL(pMPred).WT)
                    If (SCHED_ANAL(pMTotl).SOT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).SOT
        
        Case "PAT": qa = (SCHED_ANAL(pMDurn).PAT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).PAT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).PAT * SCHED_ANAL(pMPred).WT)
                    If (SCHED_ANAL(pMTotl).PAT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).PAT
        
        Case "POT": qa = (SCHED_ANAL(pMDurn).POT * SCHED_ANAL(pMDurn).WT) + (SCHED_ANAL(pMFixd).POT * SCHED_ANAL(pMFixd).WT) + (SCHED_ANAL(pMPred).POT * SCHED_ANAL(pMPred).WT)
                    If (SCHED_ANAL(pMTotl).POT <> 0) Then qa = qa / SCHED_ANAL(pMTotl).POT
    End Select
    qw = SCHED_ANAL(pMDurn).WT + SCHED_ANAL(pMFixd).WT + SCHED_ANAL(pMPred).WT
    qs = (1 - qa / qw) * 100
    qsM = Format(qs, "#0.0")

End Function

我尝试使用 CallByName 函数，但不认为它适合数据结构。不知道还能尝试什么。

Answer 1

假设所有分析的 SAT、SOT、PAT 和 POT 都相同，将它们从数组中分解出来，并创建一个函数，对所有质量分数计算仅执行一次选择案例。

Public SAT As Long      ' schedule, all task count
Public SOT As Long      ' schedule, open task count
Public PAT As Long      ' period, all task count
Public POT As Long      ' period, open task count

Public Const NoAnalItems As Integer = 35                ' Number of analysis items

Public Type SA_Array                ' SA = Schedule Analysis
    Item As String                  ' Name of the analysis item
    WT As Integer                   ' Quality score weight
    Category As String              ' Category of the analysis item
    Description As String           ' Decription of the item for display on the help screen
    Risk As String                  ' Risk associated with the item for display on the help screen
    ExecuteCheckbox As CheckBox     ' Pointer to associated analysis item checkbox; TRUE if executed, FALSE if not
    RepairButton As CommandButton   ' Pointer to associated analysis item repair button
End Type
Public SCHED_ANAL(NoAnalItems) As SA_Array


Function TaskCount(stype As String) As Long
    Select Case stype
        Case Is = "SAT": TaskCount = SAT
        Case Is = "SOT": TaskCount = SOT
        Case Is = "PAT": TaskCount = PAT
        Case Is = "POT": TaskCount = POT
    End Select
End Function

Function qsM(stype As String) As String

    On Error Resume Next

    Dim numTasks As Long
    numTasks = TaskCount(stype)
    
    Dim qa As Single
    qa = (numTasks * SCHED_ANAL(pMDurn).WT) + (numTasks * SCHED_ANAL(pMFixd).WT) + (numTasks * SCHED_ANAL(pMPred).WT)
    If numTasks <> 0 Then
        qa = qa / numTasks
    End If

    Dim qw As Single
    qw = SCHED_ANAL(pMDurn).WT + SCHED_ANAL(pMFixd).WT + SCHED_ANAL(pMPred).WT
    
    Dim qs As Single
    qs = (1 - qa / qw) * 100
    
    qsM = Format(qs, "#0.0")

End Function