您可以使用字典对象来存储每个可能的排名并关联到一个0值。然后循环通过选定的记录并更新字典中的计数并返回预期的输出。
请注意，我的小数点分隔符是逗号，所提供的代码不处理任何错误，但它可以成为您的起点。
我的表单是这样的，所有的代码都在命令按钮中：

Option Explicit

Private Sub CMD_CALCULATE_Click()
Dim MyDict As Object
Dim i As Long
Dim rankR As Range
Dim RanksArray As Variant
Dim MyF As WorksheetFunction
Dim pValue As Double
Dim vRank As String
Dim FinalOutput As String
Dim MyKey As Variant

Set MyDict = CreateObject("Scripting.Dictionary")
Set rankR = Worksheets("Data").Range("WorkerRankList")
Set MyF = WorksheetFunction

'set p value (don't know where you get this)
pValue = CDbl(Me.TXT_PVALUE)

'add all posible ranks
RanksArray = Array("Junior", "Officer", "Supervisor", "Manager")

For i = LBound(RanksArray) To UBound(RanksArray) Step 1
    MyDict.Add RanksArray(i), 0
Next i

'now check what values are selected on lstDV and update dictionary
With lstDV
    For i = 0 To .ListCount - 1 Step 1
        If .Selected(i) = True Then
            'worker selected, get their rank
            vRank = MyF.VLookup(.List(i), rankR, 2, 0)
            'update dictionary increasing 1 the rank
            MyDict(vRank) = MyDict(vRank) + 1
        End If
    Next i
End With

'now the dictionary hold the total count of each rank. Just check if the value is zero or not
' also, apply your p value if the dictionary value is not zero. Loop trough dictionary

For Each MyKey In MyDict.Keys
    If MyDict(MyKey) <> 0 Then FinalOutput = FinalOutput & MyKey & "*" & pValue * MyDict(MyKey) & ","
Next MyKey

'get rid of the last comma on final output
FinalOutput = Left(FinalOutput, Len(FinalOutput) - 1)

'return final output
Me.TXT_RESULT.Text = FinalOutput

'clean variables
Set MyDict = Nothing
Erase RanksArray
Set rankR = Nothing
Set MyF = Nothing

End Sub

还复制了您的员工范围：

我在案例1和案例2中得到的输出是这样的：

请检查：
How to determine the items that are selected in a ListBox control
Excel VBA Dictionary – A Complete Guide
已将示例上传到Google云端硬盘，以备您查看：https://drive.google.com/file/d/1BrllA7vpTB837pViIlsh3DUB44DYJEPX/view?usp=sharing

当然有更好的方法来获得你想要的（数组，字典），但是考虑到有限的信息量，我已经开发了一个小插件到你的代码编辑你的myRank .添加到你的代码结束：

'Resetting variables.
    strRank = myRank
    myRank = ""
    
    'Covering each section of the string delimited by ",".
    For x = 0 To UBound(Split(strRank, ","))
        
        'Setting newRank as the given section (rank).
        newRank = Split(Split(strRank, ",")(x), "*")(0)
        
        'Checking if the given newRank hasn't already been processed.
        If Len(Replace(myRank, newRank, "")) = Len(myRank) Then
            
            'Adding newRank to myRank while also counting how many newRank have been specified in the record.
            myRank = myRank & newRank & "*" & (Len(strRank) - Len(Replace(strRank, newRank & "*", ""))) / Len(newRank & "*") & ","
            
        End If
        
    Next
    
    'Removing the last "," if necessary.
    If Right(myRank, 1) = "," Then
        myRank = Left(myRank, Len(myRank) - 1)
    End If

编辑

在注解之后，这里是以前解决方案的更新版本：

'Resetting variables.
    strRank = myRank
    myRank = ""
    
    'Declarations.
    Dim DblCounter As Double
    
    
    'Covering each section of the string delimited by ",".
    For x = 0 To UBound(Split(strRank, ", "))
        
        'Setting newRank as the given section (rank).
        newRank = Split(Split(strRank, ", ")(x), "*")(0)
        
        'Checking if the given newRank hasn't already been processed.
        If Len(Replace(myRank, newRank & "*", "")) = Len(myRank) Then
            
            'Setting DblCounter.
            DblCounter = 0
            
            'Counting how many full-hour are there for the given rank.
            DblCounter = (Len(strRank) - Len(Replace(strRank, newRank & "*1", ""))) / Len(newRank & "*1")
            
            'Counting how many half-hour are there for the given rank.
            DblCounter = DblCounter + (Len(strRank) - Len(Replace(strRank, newRank & "*0.5", ""))) / Len(newRank & "*0.5") * 0.5
            
            'Adding newRank to myRank followed by DblCounter.
            myRank = myRank & newRank & "*" & Replace(DblCounter, ",", ".") & ", "
            
        End If
        
    Next
    
    'Removing the last ", " if necessary.
    If Right(myRank, 2) = ", " Then
        myRank = Left(myRank, Len(myRank) - 2)
    End If

顺便说一句：前面的代码确实返回了那些奇怪的结果，因为用“，”分割。这样，第一个排名将是（例如）“Junior”，而后面遇到的另一个Junior将被标记为“Junior”。用“，”而不是“，”分割解决了这个问题。
如前所述：使用字典或数组的解决方案可能会更优雅和合适。这更像是一个补丁，而不是一套定制的西装：更容易实现，功能上也可以接受，但不是最好的方法。