excel vba 成本分析表插入函数

Attribute VB_Name = "模块1"

Sub 基本完成()

Dim start, finish, totaltime

start = Timer '计时开始

Dim i As Long

Dim ws As Worksheet

Set ws = Worksheets("销售发票序时簿") '定义工作簿引用

i = ws.Range("e1").End(xlDown).Row + 1

Rows(i).Select

Selection.Cut                  '合计行备份，以便后面核对

Sheets.Add after:=Sheet1

ActiveSheet.Paste               '粘贴合计行到新建的工作表中

Worksheets("销售发票序时簿").Select

Columns("a:d").Select

Selection.Delete Shift:=xlToLeft    '删除原表中左边多余的四列数据

Columns("A:A").Select  '添加类别

Selection.Insert Shift:=xlToRight   '插入方式，左侧

Range("A1").Select

ActiveCell.FormulaR1C1 = "类别"

Dim x As Long        '添加内外销

Dim a As String

Dim b As String

For x = 2 To Range("e1").End(xlDown).Row '判断有数据的有多少行，从第二行开始算

    If Cells(x, 9).Value = 1 Then   '汇率等于1判断为内销

    a = "内销"

    Else

    a = "外销"        '否则其他汇率判断为外销

    End If

    b = Cells(x, 2).Value     'b代表部门

    Cells(x, 1).Value = a & "(" & b & ")"   '每行的参数设置好后程序逐条编辑

Next

Dim y As Long

y = Range("a1").End(xlToRight).Column        '查找数据最大边界，前面x已经找到行，现在y找列

Columns("I:I").Select    '汇率排序

Cells(x, y).Sort Key1:=Range("i1"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlPinYin, DataOption1:=xlSortNormal

        

Columns("a:a").Select   '部门排序

Cells(x, y).Sort Key1:=Range("a1"), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

SortMethod:=xlPinYin, DataOption1:=xlSortNormal

'下面是删除右侧不需要的多余列

Columns("n:ab").Select

Selection.Delete Shift:=xlToRight    '删除原表中右边多余的列数据

Range("n1").Select

ActiveCell.FormulaR1C1 = "单位成本"   '添加各个字段

Range("o1").Select

ActiveCell.FormulaR1C1 = "销售成本"

Range("p1").Select

ActiveCell.FormulaR1C1 = "进项转出率"

Range("q1").Select

ActiveCell.FormulaR1C1 = "进项转出额"

Range("r1").Select

ActiveCell.FormulaR1C1 = "管理总成本"

Range("s1").Select

ActiveCell.FormulaR1C1 = "毛利"

Range("t1").Select

ActiveCell.FormulaR1C1 = "毛利率"

Range("u1").Select

ActiveCell.FormulaR1C1 = "备注"

For x = 2 To Range("h1").End(xlDown).Row

If Cells(x, 8).Value <> "人民币" Then Cells(x, 17).Formula = "=RC[-4]*RC[-1]"  '外销进项转出额设置公式

Next

For x = 2 To Range("h1").End(xlDown).Row

Cells(x, 18).FormulaR1C1 = "=RC[-3]+RC[-1]"  '管理总成本设置公式，此公式参数变动，结果也随时动，便于日常数据添加编辑

Cells(x, 19).Formula = "=RC[-6]-RC[-1]"  '毛利设置公式

Cells(x, 20).Formula = "=RC[-1]/RC[-7]" '毛利率设置公式，注意 range("s"&x)/range("m"&x)也可以，但公式隐含的，不运行代码不会结果更新

On Error Resume Next

Next

finish = Timer

totaltime = finish - start   '计算总共用时

MsgBox "总共用时" & totaltime & "秒，奶奶的，满意了吧，滚去睡觉吧！"

End Sub

Sub 测试行数()

 If Range("a79").Value Like "内销*汇总" Then

MsgBox "测试", vbOKOnly, "正确"

End If

End Sub