在输入末行数据时余额公式自动复制上一行公式

wowo000

feiaoli 发表于 2022-3-3 18:43
谢谢老师，麻烦您再给修改一下，就可以了。

合计行余额这里是上面的单元格公式应该既可以

楼主：修改了一下，试试。

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim arr, r, ir, heji
   
3. If AutoFilterMode = True Then
   
4.   arr = Sheet1.UsedRange
   
5.   r = UBound(arr)
   
6.   If Cells(r, 5).HasFormula = False Then
   
7.      Me.Range("E" & r + 1 & ":F" & r + 1).FormulaR1C1 = "=subtotal(9,r2c:r[-1]c)"
   
8.      Me.Range("G" & r + 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
   
9.      Me.Range("A" & r + 1) = "合计："
   
10. '     Me.Range("A" & r + 1 & ":D" & r + 1).Merge
    
11.     With Me.Range("A" & r + 1 & ":D" & r + 1)
    
12.         .HorizontalAlignment = xlCenterAcrossSelection
    
13.         .VerticalAlignment = xlCenter
    
14.         .ReadingOrder = xlContext
    
15.     End With
    
16.      For ir = 3 To UBound(arr)
    
17.          Me.Range("G" & 3 & ":G" & ir).FormulaR1C1 = "=SUBTOTAL(109,R2C7,R2C5:RC[-2])-SUBTOTAL(109,R2C6:RC[-1])"
    
18.      Next ir
    
19.   End If
    
20. End If
    
21. If AutoFilterMode = False Then
    
22. arr = Sheet1.UsedRange
    
23.   r = UBound(arr)
    
24.   If Me.Cells(r, 5).HasFormula = True Then
    
25.      Me.Cells(r, 1).EntireRow.Delete
    
26.      Me.Cells(r + 1, 1).EntireRow.Delete
    
27.   End If
    
28. End If
    
29. End Sub

复制代码

feiaoli

wowo000 发表于 2022-3-3 12:39

老师您好，我简单的修改了一下您的代码，表格样子和思路也稍微改动了一下，可以使用了。如果”合计“两个字在AD列跨列居中就更美观一点，您看可以吗，怎么修改呢？

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim arr, r, ir, heji
   
3. If AutoFilterMode = True Then
   
4.   arr = Sheet1.UsedRange
   
5.   r = UBound(arr)
   
6.   If Cells(r, 5).HasFormula = False Then
   
7.      Me.Range("E" & r + 1 & ":F" & r + 1).FormulaR1C1 = "=subtotal(9,r2c:r[-1]c)"
   
8.      Me.Range("A" & r + 1) = "合计："
   
9.      Me.Range("A" & r + 1 & ":D" & r + 1).UnMerge
   
10.      For ir = 3 To UBound(arr)
    
11.          Me.Range("G" & 3 & ":G" & ir).FormulaR1C1 = "=SUBTOTAL(109,R2C5:RC[-2])-SUBTOTAL(109,R2C6:RC[-1])"
    
12.                                                      ' SUBTOTAL(109,R2C7,R2C5:RC[-2])-SUBTOTAL(109,R2C6:RC[-1])
    
13.      Next ir
    
14.   End If
    
15. End If
    
16. If AutoFilterMode = False Then
    
17. arr = Sheet1.UsedRange
    
18.   r = UBound(arr)
    
19.   If Me.Cells(r, 5).HasFormula = True Then
    
20.      Me.Cells(r, 1).EntireRow.Delete
    
21.      For ir = 3 To UBound(arr)
    
22.          Me.Range("G" & 3 & ":G" & ir).FormulaR1C1 = "=SUBTOTAL(109,R2C5:RC[-2])-SUBTOTAL(109,R2C6:RC[-1])"
    
23.                                                     '  SUBTOTAL(109,R2C7,R2C5:RC[-2])-SUBTOTAL(109,R2C6:RC[-1])
    
24.      Next ir
    
25.   End If
    
26. End If
    
27. End Sub
    

复制代码

？

feilanga

个人认为不应该在源数据上面直接处理，源数据就是源数据，需要筛选查询或者更多条件查询，可以另外做个查询表，想怎么查就怎么查，还不会破坏源数据

feiaoli

feilanga 发表于 2022-3-4 11:09
个人认为不应该在源数据上面直接处理，源数据就是源数据，需要筛选查询或者更多条件查询，可以另外做个查询 ...

谢谢您的提醒。