EXCEL VBA - 自動加總

以下是學生的要求
我簡單的完成一些基本功能
Dim F_CALC, J_CALC, K_CALC
Dim xi, ti As Integer
Sub 執行答案()

複製工作表
計算Vender和
插入Product列
計算Product和

End Sub
Sub 計算Vender和()

Range("A4").Select
Selection.End(xlDown).Select

vnum = ActiveCell.Row
ActiveCell.Offset(1, 0).Select
vsum = (vnum - 3) * (-1)
snum = -1

ActiveCell.Offset(0, 2).Value = "Total Amount of all venders"
For i = 6 To 17
ActiveCell.Offset(0, i).Formula = "=SUM(R[" & vsum & "]C:R[" & snum & "]C)"
Next i

End Sub


Sub 插入Product列()
ri = 4
ti = 0
Range("A4").Select
Selection.End(xlDown).Select
rnum = ActiveCell.Row
Range("A4").Select

While (ri <> rnum)

If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
ActiveCell.Offset(1, 0).Select
ti = ti + 1
tx = ActiveCell.Row + 1

Else

tnums = tx & ":" & tx
Rows(tnums).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

計算Product和

ActiveCell.Offset(1, 0).Select

End If

ri = ri + 1

Wend

ActiveCell.Offset(1, 0).Select


End Sub

Sub 計算Product和()
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(0, 1).Value = ActiveCell.Value & "total sum"

End Sub
Sub 插入列()
i = 4
xs = 0
xs1 = 0
xs2 = 0


Range("B4").Select
Selection.End(xlDown).Select
rnum = ActiveCell.Row
Range("B4").Select


x1 = ActiveCell.Value
x2 = ActiveCell.Offset(0, -1).Value
x3 = ActiveCell.Offset(0, 2).Value
x4 = ActiveCell.Offset(0, 3).Value
計算F
x6 = ActiveCell.Offset(0, 5).Value
x7 = ActiveCell.Offset(0, 6).Value
x8 = ActiveCell.Offset(0, 7).Value

計算TTL_Q
計算TTL_S

x10 = ActiveCell.Offset(0, 10).Value
x11 = ActiveCell.Offset(0, 11).Value
x12 = ActiveCell.Offset(0, 12).Value


If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
rsum1 = ActiveCell.Row
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 2).Value = x3
ActiveCell.Offset(0, 3).Value = x4
ActiveCell.Offset(0, 4).Value = F_CALC
xs = x6 + xs
xs1 = x7 + xs1
xs2 = x8 + xs2
ActiveCell.Offset(0, 8).Value = J_CALC
ActiveCell.Offset(0, 9).Value = K_CALC

Else
xs = x6 + xs
xs1 = x7 + xs1
xs2 = x8 + xs2
ActiveCell.Offset(1, 0).Select
rx = ActiveCell.Row
rnums = rx & ":" & rx
Rows(rnums).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

rc = "B" & rx
Range(rc).Select
ActiveCell.Value = x1
ActiveCell.Offset(0, -1).Value = x2
ActiveCell.Offset(0, 1).Value = "sub amount"
ActiveCell.Offset(0, 2).Value = x3
ActiveCell.Offset(0, 3).Value = x4

計算F

ActiveCell.Offset(0, 5).Value = xs
ActiveCell.Offset(0, 6).Value = xs1
ActiveCell.Offset(0, 7).Value = xs2
xs = 0
xs1 = 0
xs2 = 0

計算TTL_Q
計算TTL_S

rc = "B" & rx + 1
Range(rc).Select
i = i - 1

End If




i = i + 1

Wend


End Sub
Sub 執行()
複製工作表
插入列

計算TTL_Q

End Sub
Sub 複製工作表()

Sheets(1).Select
Sheets(1).Copy Before:=Sheets(1)
Sheets(1).Select
End Sub
Sub 陣列()

xx(0) = ActiveCell.Value
xx(1) = ActiveCell.Offset(0, -1).Value
For xi = 2 To 7

xx(i) = ActiveCell.Offset(0, xi).Value
Next

End Sub


Sub 計算TTL_S()
ActiveCell.Offset(0, 9).FormulaR1C1 = "=RC[-1]*RC[-5]"
K_CALC = ActiveCell.Offset(0, 9).Formula

End Sub
Sub 計算F()

ActiveCell.Offset(0, 4).FormulaR1C1 = "=RC[-2]+RC[-1]"
F_CALC = ActiveCell.Offset(0, 4).Formula

End Sub
Sub 計算TTL_Q()

ActiveCell.Offset(0, 8).FormulaR1C1 = "=RC[-3]+RC[-2]+RC[-1]"
J_CALC = ActiveCell.Offset(0, 8).Formula


End Sub