↑が見づらかったので、再度データのみ記載します。

（元データ）
年	月	日	購入品	金額	累計
5	7	1	みかん	300	300
5	7	1	なし	200	500
5	7	1	ぶどう	500	1000
5	7	1	りんご	200	1200
5	7	2	みかん	300	1500
5	7	2	なし	200	1700
5	7	2	ぶどう	500	2200
5	7	2	りんご	200	2400
5	7	3	みかん	300	2700
5	7	3	なし	200	2900
5	7	3	ぶどう	500	3400
5	7	3	りんご	200	3600
5	7	4	みかん	300	3900
5	7	4	なし	200	4100
5	7	4	ぶどう	500	4600
5	7	4	りんご	200	4800

（変更データ）
年	月	日	購入品	金額	累計	
5	7	1	みかん	300	300	←先頭行の金額は残す
			なし	200		
			ぶどう	500		
			りんご	200	1200	
5	7	2	みかん	300		
			なし	200		
			ぶどう	500		
			りんご	200	2400	
5	7	3	みかん	300		
			なし	200		
			ぶどう	500		
			りんご	200	3600	
5	7	4	みかん	300		
			なし	200		
			ぶどう	500		
			りんご	200	4800	

マナ 様
ご教示いただきありがとうございます。

シート上では変更できたのですが、配列内で変更することが出来なく困っておりました。
お陰様で何とか形にすることは出来ました。
誠に勝手ながら、他により良い方法があれば教えていただけると助かります。

Sub 不要な値を消去()
    Dim Ws1 As Worksheet: Dim Ws2 As Worksheet: Dim r As Integer
    Dim i As Long: Dim Jn As Variant
    Dim Data As Variant: Dim RData As Variant
    With ThisWorkbook
        Set Ws1 = .Worksheets("sheet1")
        Set Ws2 = .Worksheets("sheet2")
    End With
    With Ws1
        Data = .Range(.Cells(2, 1), .Cells(17, 7)) '元データ
        For i = 1 To UBound(Data)
            Jn = Array(Data(i, 1), Data(i, 2), Data(i, 3))
            Data(i, 7) = Val(Join(Jn))
        Next i
        r = 1
        ReDim RData(1 To 18, 1 To 7) '変更データ
        If r = 1 Then
            RData(r, 1) = Data(1, 1)
            RData(r, 2) = Data(1, 2)
            RData(r, 3) = Data(1, 3)
            RData(r, 4) = Data(1, 4)
            RData(r, 5) = Data(1, 5)
            RData(r, 6) = Data(1, 6)
            RData(r, 7) = Data(1, 7)
            r = r + 1
        End If
        For i = 2 To UBound(Data)
            RData(r, 4) = Data(i, 4)
            RData(r, 5) = Data(i, 5)
            RData(r, 7) = Data(i, 7)
            If RData(r - 1, 7) <> Data(i, 7) Then
                RData(r, 1) = Data(i, 1)
                RData(r, 2) = Data(i, 2)
                RData(r, 3) = Data(i, 3)
            End If
            If RData(r - 1, 7) <> RData(r, 7) Then
                RData(r - 1, 6) = Data(i - 1, 6)
            End If
            If i = UBound(Data) Then
                RData(r, 6) = Data(i, 6)
            End If
            r = r + 1
        Next i: Erase Data
        Ws2.Cells(2, 1).Resize(UBound(RData), 6) = RData: Erase RData
    End With: Set Ws2 = Nothing: Set Ws1 = Nothing
End Sub

ありがとうございました。

こんな感じで考えていました

Sub test()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim Data, r As Long
    
    With ThisWorkbook
        Set Ws1 = .Worksheets("sheet1")
        Set Ws2 = .Worksheets("sheet2")
    End With
    
    Data = Ws1.Cells(1).Resize(17, 6).Value '元データ
    
    For r = UBound(Data, 1) - 1 To 2 Step -1
        If Data(r, 1) & vbTab & Data(r, 2) & vbTab & Data(r, 3) _
            = Data(r + 1, 1) & vbTab & Data(r + 1, 2) & vbTab & Data(r + 1, 3) Then
            Data(r + 1, 1) = ""
            Data(r + 1, 2) = ""
            Data(r + 1, 3) = ""
            If r = 2 Then Exit For
            Data(r, 6) = ""
        End If
    Next
    
    Ws2.Cells(1).Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
    
End Sub