VBA自动识别合并单元格及计算相邻单元格

proving

需要识别合并单元格中的数据，已一个合并单元格的行宽为一组，计算每组中的单价。
请大神参考附件中的数据。

hshj99

Sub yy()
    Dim sh As Worksheet, f, s$, rn As Range, rng As Range
   
    Set sh = ActiveSheet
    r = sh.Cells(Rows.Count, 1).End(3).Row
    If r > 1 Then
        Set d = CreateObject("Scripting.Dictionary")
        Set rng = sh.Cells(2, 3).Resize(r - 1)
        For Each rn In rng
            If rn.MergeCells Then
                s = rn.MergeArea.Address
                If Not d.Exists(s) Then
                    d.Add s, rn.MergeArea.Count
                End If
            Else
                d.Add rn.Address, 1
            End If
        Next
        For Each f In d.keys
            Set rng = sh.Range(f)
            For Each rn In rng
                rn.Offset(, 1) = "=" & rng.Cells(1).Address & "/Sum(" & rng.Offset(, -1).Resize(d(f)).Address & ")*" & rn.Offset(, -1).Address
            Next
        Next
        Set d = Nothing
    End If
End Sub