>>12

考えてみた。

Sub test()

Dim i As Long
Dim n As Long
Dim LastRow As Long
Dim SplCell(1) As String　←変更。(0)はアルファベットを格納、(1)はアルファベット以降の金額部を格納。
Dim temp As Variant
Dim AddRow As Long
Dim m As Double　←追加。行数で分割した金額。

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = LastRow To 1 Step -1
SplCell(0) = Left(Cells(i, 1), 4)　←追加
SplCell(1) = Mid(Cells(i, 1), 5)　←変更
temp = Split(SplCell(1), "/")
AddRow = UBound(temp)
If AddRow > 0 Then
Range("A" & i + 1).Resize(AddRow).EntireRow.Insert
End If

m = Cells(i, 2) / (AddRow + 1)　追加
For n = 0 To AddRow
Cells(i + n, 1) = SplCell(0) & temp(n)　←変更
Cells(i + n, 2) = m　←変更
Next n
Next i
End Sub