效果如下：

核心代码：

Sub AddListViewItem(strStyle As String)

    Me.ListView1.ListItems.Clear
    
    Dim selectedCells As Range
    Dim objDataRanges As Range
    Dim cell As Range
    Dim colorDict As Object
    Set colorDict = CreateObject("Scripting.Dictionary")
    
    On Error Resume Next
    Set selectedCells = Selection
    On Error GoTo 0
    
    If selectedCells Is Nothing Or selectedCells.Cells.Count = 1 Then
        MsgBox "请选中多个单元格。", vbExclamation
        Exit Sub
    End If
    
    ' 筛选仅包含数字的单元格
    For Each cell In selectedCells.Cells
        If IsNumeric(cell.Value) Then
            If objDataRanges Is Nothing Then
                Set objDataRanges = cell
            Else
                Set objDataRanges = Union(objDataRanges, cell)
            End If
        End If
    Next cell
    
    If objDataRanges Is Nothing Or objDataRanges.Cells.Count = 1 Then
        MsgBox "选中的单元格中没有足够的数字单元格。", vbExclamation
        Exit Sub
    End If
    
    ' 根据 strStyle 判断操作
    If strStyle = "BackgroundColor" Then

        For Each cell In objDataRanges.Cells
            Dim bgColor As Long
            bgColor = cell.Interior.color

            If Not colorDict.exists(bgColor) Then
                colorDict(bgColor) = ""
            End If
            
            colorDict(bgColor) = colorDict(bgColor) & ";" & cell.Value
        Next cell
        
        Call AddStatisticsToListView(colorDict, True)
        
    ElseIf strStyle = "ForeColor" Then
        For Each cell In objDataRanges.Cells
            Dim foreColor As Long
            foreColor = cell.Font.color
            
            If Not colorDict.exists(foreColor) Then
                colorDict(foreColor) = "" 
            End If
            
            colorDict(foreColor) = colorDict(foreColor) & ";" & cell.Value
        Next cell
        
        Call AddStatisticsToListView(colorDict, False)
        
    End If
End Sub

Sub AddStatisticsToListView(colorDict As Object, isBackground As Boolean)
    Dim color As Variant
    Dim item As ListItem
    Dim colorArray As Variant
    Dim medianValue As Variant, avgValue As Double, maxValue As Double, minValue As Double, totalValue As Double
    Dim numValues() As Double
    Dim countValue As Integer
    Dim i As Integer
    
    For Each color In colorDict.Keys
        ' 解析
        colorArray = Split(colorDict(color), ";")
        
        countValue = 0
        totalValue = 0
        
        If UBound(colorArray) >= 1 Then
            ReDim numValues(UBound(colorArray) - 1)
            
            For i = 1 To UBound(colorArray)
                If IsNumeric(Trim(colorArray(i))) Then
                    numValues(countValue) = CDbl(Trim(colorArray(i)))
                    countValue = countValue + 1
                    totalValue = totalValue + numValues(countValue - 1)
                End If
            Next i
        End If
        
        If countValue = 0 Then
            GoTo ContinueLoop
        End If        

        ReDim Preserve numValues(countValue - 1)
        
        ' 计算统计数据
        avgValue = Round(totalValue / countValue, 2)
        maxValue = Round(WorksheetFunction.Max(numValues), 2) 
        minValue = Round(WorksheetFunction.Min(numValues), 2) 
        
        If countValue > 1 Then
            medianValue = Round(WorksheetFunction.Median(numValues), 2) ' 中位数，保留两位小数
        Else
            medianValue = "-"
        End If
        
        Set item = ListView1.ListItems.Add
        
        If isBackground Then
            item.text = "背景颜色"
            item.Bold = True
            item.foreColor = color 
        Else
            item.text = "字体颜色"
            item.Bold = True
            item.foreColor = color
        End If
        

        item.SubItems(1) = countValue ' 数量
        item.SubItems(2) = Format(Round(totalValue, 2), "0.00") ' 合计数
        item.SubItems(3) = Format(avgValue, "0.00") ' 平均值
        item.SubItems(4) = Format(medianValue, "0.00") ' 中位数
        item.SubItems(5) = Format(maxValue, "0.00") ' 最大值
        item.SubItems(6) = Format(minValue, "0.00") ' 最小值
        
ContinueLoop:
    Next color
End Sub