|
本帖最后由 sqrall900 于 2024-10-30 13:10 编辑
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DC1, RS(1 To 1, 1 To 4), R1 As Integer, C1 As Integer, i As Integer, j As Integer
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim WS As Worksheet
Set WS = Target.Worksheet
For Each Rng1 In Target
R1 = Rng1.Row
C1 = Rng1.Column
Set Rng3 = Rng1.Offset(-1)
If Rng1 = "合计" And Rng1.Column = 9 And Rng3 <> "合计" Then
Set Rng2 = WS.Range(Cells(1, C1), Cells(R1 - 1, C1)).Find("合计", SearchDirection:=xlPrevious)
If Rng2 Is Nothing Then
R2 = 4
Else
R2 = Rng2.Row + 1
End If
DC1 = WS.Range(Cells(R2, C1), Cells(R1 - 1, C1 + 4))
For i = 1 To R1 - R2
For j = 1 To 4
RS(1, j) = RS(1, j) + DC1(i, j + 1)
Next
j = 1
Next
i = 1
Rng1.Offset(0, 1).Resize(1, 4) = RS
Erase DC1
Erase RS
End If
Next
End Sub
|
|