Joforn

1. Sub Test()
   
2.   Dim I           As Long
   
3.   Dim EndRow      As Long
   
4.   Dim Ranges      As Range
   
5.   Dim Range1      As Range
   
6.   Dim strFormula  As String
   
7.   
   
8.   EndRow = Range("A" & Rows.Count).End(xlUp).Row
   
9.   For I = 1 To EndRow
   
10.     With Range("A" & I)
    
11.       Select Case Trim$(.Value)
    
12.         Case "小計"
    
13.           .Offset(0, 1).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
    
14.           If Ranges Is Nothing Then
    
15.             Set Ranges = .Offset(0, 1)
    
16.           Else
    
17.             Set Ranges = Union(Ranges, .Offset(0, 1))
    
18.           End If
    
19.         Case "總計"
    
20.           If Not Ranges Is Nothing Then
    
21.             strFormula = vbNullString
    
22.             For Each Range1 In Ranges
    
23.               With Range1
    
24.                 If Len(strFormula) Then
    
25.                   strFormula = strFormula & "," & .Address
    
26.                 Else
    
27.                   strFormula = .Address
    
28.                 End If
    
29.               End With
    
30.             Next Range1
    
31.             Set Ranges = Nothing
    
32.             .Offset(0, 1).Formula = "=SUM(" & strFormula & ")"
    
33.           End If
    
34.       End Select
    
35.     End With
    
36.   Next
    
37. End Sub

複製代碼

Joforn

回復 4# popomilk

1. Sub Test()
   
2.   Dim I           As Long
   
3.   Dim R As Long, EndRow As Long
   
4.   Dim strValue    As String
   
5.   Dim Ranges      As Range
   
6.   Dim Range1      As Range
   
7.   Dim strFormula  As String
   
8.   
   
9.   EndRow = Range("A" & Rows.Count).End(xlUp).Row
   
10.   For I = 1 To EndRow
    
11.     With Range("A" & I)
    
12.       strValue = Trim$(.Value)
    
13.       Select Case strValue
    
14.         Case "小計"
    
15.           .Offset(0, 1).FormulaR1C1 = "=SUM(R[" & R - I & "]C:R[-1]C)"
    
16.           R = 0
    
17.           If Ranges Is Nothing Then
    
18.             Set Ranges = .Offset(0, 1)
    
19.           Else
    
20.             Set Ranges = Union(Ranges, .Offset(0, 1))
    
21.           End If
    
22.         Case "總計"
    
23.           If Not Ranges Is Nothing Then
    
24.             strFormula = vbNullString
    
25.             For Each Range1 In Ranges
    
26.               With Range1
    
27.                 If Len(strFormula) Then
    
28.                   strFormula = strFormula & "," & .Address
    
29.                 Else
    
30.                   strFormula = .Address
    
31.                 End If
    
32.               End With
    
33.             Next Range1
    
34.             Set Ranges = Nothing
    
35.             .Offset(0, 1).Formula = "=SUM(" & strFormula & ")"
    
36.           End If
    
37.         Case Else
    
38.           If R = 0 Then
    
39.             If strValue Like "###########" Then R = I
    
40.           End If
    
41.       End Select
    
42.     End With
    
43.   Next
    
44. End Sub

複製代碼

Joforn

回復 14# popomilk
Sub Test()
  Dim xR As Range
  
  Set xR = Range("A7")
  With xR
    If Trim$(.Value) = "總計" Then
      .Offset(0, 1).Formula = "=SUMIF(A:A,""*小計*"",B:B)"
      '.Offset(0, 1).FormulaR1C1 = "=SUMIF(C[-1],""*小計*"",C)" '這條語句與上一條語句在這裡是相同的效果，但不同的位置公式不一樣，所以上面那條比較好用。
    End If
  End With
End Sub