分享：最新的成本核算系统

wllsxjc

有没有建筑业分项目的成本核算系统了？

ckjy2006

sgjccj 发表于 2018-3-8 15:42
好东西，谢谢楼主了

谢楼主，顶起来

yzxfelix

Sub 成本汇总更新()

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
  
  Sheet1.Range("X3") = "=公式1" '（1、在数据库1中计算有完工产量的产品）
Sheet1.Range("X3").AutoFill Sheet1.Range("X3:X1000")
  Sheet1.Range("B3") = "=公式2" '（2、在数据库1中将有完工产品的名称排序）"
Sheet1.Range("B3").AutoFill Sheet1.Range("B3:B1000")

mmmm = Range("z4") '复制（3、清除公式1多余部分）
nnnn = Range("z5") '粘贴到数据库1的位置
p = Sheets("数据库1").Range(mmmm)
Sheets("数据库1").Range(nnnn) = p
oooo = Range("z5") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("z4") '复制（3、清除公式2多余部分）
jjjj = Range("z6") '粘贴到数据库1的位置
l = Sheets("数据库1").Range(iiii)
Sheets("数据库1").Range(jjjj) = l
kkkk = Range("z6") '粘贴到数据库1所在的区域（起始行和末行）。

Sheet10.Range("C6") = "=IF(B3=0,0,1)" '（4、汇总表排序）
Sheet10.Range("C7") = "=IF(OR(C6=0,C6>=$B$3),0,1+MAX($C$6:C6))" '（1、计算金额）
Sheet10.Range("C7").AutoFill Sheet10.Range("C7:C1000")
  
Sheet10.Range("D6") = "=公式11" '（4、产品名称）
Sheet10.Range("D6").AutoFill Sheet10.Range("D6:D1000")

  Sheet10.Range("E6") = "=公式10" '（5、计量单位）
Sheet10.Range("E6").AutoFill Sheet10.Range("E6:E1000")
  Sheet10.Range("F6") = "=公式9" '（6、产量）
Sheet10.Range("F6").AutoFill Sheet10.Range("F6:F1000")
   
   Sheet10.Range("G6") = "=I6+K6+M6+O6+Q6" '（7、总成本）
Sheet10.Range("G6").AutoFill Sheet10.Range("G6:G1000")
  Sheet10.Range("H6") = "=IF(F6*G6=0,0,G6/F6)"
Sheet10.Range("H6").AutoFill Sheet10.Range("H6:H1000")
  
   Sheet10.Range("I6") = "=公式3" '(8、材料成本)
Sheet10.Range("I6").AutoFill Sheet10.Range("I6:I1000")
   Sheet10.Range("J6") = "=IF($F6*I6=0,0,I6/$F6)"
Sheet10.Range("J6").AutoFill Sheet10.Range("J6:J1000")
  
  Sheet10.Range("K6") = "=公式4" '(9、辅助材料成本)
Sheet10.Range("K6").AutoFill Sheet10.Range("K6:K1000")
   Sheet10.Range("L6") = "=IF($F6*K6=0,0,K6/$F6)"
Sheet10.Range("L6").AutoFill Sheet10.Range("L6:L1000")
  
   Sheet10.Range("M6") = "=公式5" '(10、燃料动力成本)
Sheet10.Range("M6").AutoFill Sheet10.Range("M6:M1000")
   Sheet10.Range("N6") = "=IF($F6*M6=0,0,M6/$F6)"
Sheet10.Range("N6").AutoFill Sheet10.Range("N6:N1000")
  
  Sheet10.Range("O6") = "=公式6" '(11、人工成本)
Sheet10.Range("O6").AutoFill Sheet10.Range("O6:O1000")
   Sheet10.Range("P6") = "=IF($F6*O6=0,0,O6/$F6)"
Sheet10.Range("P6").AutoFill Sheet10.Range("P6:P1000")
  
  Sheet10.Range("Q6") = "=公式7" '(12、制造费用)
Sheet10.Range("Q6").AutoFill Sheet10.Range("Q6:Q1000")
   Sheet10.Range("R6") = "=IF($F6*Q6=0,0,Q6/$F6)"
Sheet10.Range("R6").AutoFill Sheet10.Range("R6:R1000")
  
  dddd = Range("Z9") '复制空白区域清除汇总表多余下拉公式
eeee = Range("Z10") '粘贴到数据库1的位置
g = Sheets("成本汇总表").Range(dddd)
Sheets("成本汇总表").Range(eeee) = g
ffff = Range("Z11") '粘贴到数据库1所在的区域（起始行和末行）
  
  MsgBox "已经更新"

  
  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End Sub

Sub 材料汇总更新()

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
  
  Sheet2.Range("N3") = "=汇总2" '（1、在数据库2中计算有数据的材料）
Sheet2.Range("n3").AutoFill Sheet2.Range("n3:n1000")
  Sheet2.Range("B3") = "=汇总1" '（2、在数据库2中将有有数据的材料名称排序）"
Sheet2.Range("B3").AutoFill Sheet2.Range("B3:B1000")

mmmm = Range("z4") '复制（3、清除汇总1多余部分）
nnnn = Range("z5") '粘贴到数据库1的位置
p = Sheets("数据库2").Range(mmmm)
Sheets("数据库2").Range(nnnn) = p
oooo = Range("z5") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("z4") '复制（3、清除汇总2多余部分）
jjjj = Range("z6") '粘贴到数据库1的位置
l = Sheets("数据库2").Range(iiii)
Sheets("数据库2").Range(jjjj) = l
kkkk = Range("z6") '粘贴到数据库1所在的区域（起始行和末行）。

Sheet11.Range("D5") = "=IF(B3=0,0,1)" '（4、材料汇总表排序）
Sheet11.Range("D6") = "=IF(OR(D5=$B$3,D5=0),0,1+MAX($D$5:D5))"
Sheet11.Range("D6").AutoFill Sheet11.Range("D6:D1000")

Sheet11.Range("E5") = "=汇总6" '(5、材料名称)
Sheet11.Range("E5").AutoFill Sheet11.Range("E5:E1000")

Sheet11.Range("F5") = "=汇总5" '(6、材料计量单位)
Sheet11.Range("F5").AutoFill Sheet11.Range("F5:F1000")
  
  Sheet11.Range("G5") = "=汇总3" '(7、材料数量)
Sheet11.Range("G5").AutoFill Sheet11.Range("G5:G1000")
  
    Sheet11.Range("I5") = "=汇总4" '(8、材料金额)
Sheet11.Range("I5").AutoFill Sheet11.Range("I5:I1000")
  
  Sheet11.Range("H5") = "=IF(G5*I5=0,0,I5/G5)" '(9、平均价格)
Sheet11.Range("H5").AutoFill Sheet11.Range("H5:H1000")
   
  MsgBox "已经更新"

  dddd = Range("Z9") '复制空白清除下方多余公式
eeee = Range("Z10") '粘贴到数据库1的位置
g = Sheets("主材汇总").Range(dddd)
Sheets("主材汇总").Range(eeee) = g
ffff = Range("Z11") '粘贴到数据库1所在的区域（起始行和末行）
  
  
  
  
  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End Sub

Sub 账簿汇总更新()

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
  
Sheet12.Range("B6") = "=账簿7" '(1、在数据库2中设置条件公式)
Sheet12.Range("B6").AutoFill Sheet12.Range("B6:B5000")

Sheet12.Range("C6") = "=账簿8" '(1、汇总条件2)
Sheet12.Range("C6").AutoFill Sheet12.Range("C6:C5000")
  
  Sheet12.Range("D6") = "=账簿1" '(2、获得月份号)
Sheet12.Range("D6").AutoFill Sheet12.Range("D6:D5000")
  
  Sheet12.Range("E6") = "=账簿2" '(3、获得凭证号)
Sheet12.Range("E6").AutoFill Sheet12.Range("E6:E5000")
  
   Sheet12.Range("F6") = "=账簿3" '(4、获得摘要)
Sheet12.Range("F6").AutoFill Sheet12.Range("F6:F5000")
  
   Sheet12.Range("G6") = "=账簿4" '(5、借方额)
Sheet12.Range("G6").AutoFill Sheet12.Range("G6:G5000")
  
      Sheet12.Range("H6") = "=账簿5" '(5、贷方额)
Sheet12.Range("H6").AutoFill Sheet12.Range("H6:H5000")
  
  Sheet12.Range("I6") = "=账簿6" '(5、余额)
Sheet12.Range("I6").AutoFill Sheet12.Range("I6:I5000")

  dddd = Range("Z4") '复制空白清除下方多余公式
eeee = Range("Z5") '粘贴到数据库1的位置
g = Sheets("账簿").Range(dddd)
Sheets("账簿").Range(eeee) = g
ffff = Range("Z6") '粘贴到数据库1所在的区域（起始行和末行）
   
   MsgBox "已经更新"
  
  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End Sub

Sub 清单更新()

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
  
Sheet2.Range("G3") = "=SUMIF(数据库2!$BF:$BF,成本计算单!$E$4&成本计算单!$E$3&$D3,$BK:$BK)" '(1、汇总条件设置，发生材料数量)
Sheet2.Range("G3").AutoFill Sheet2.Range("G3:G1000")

Sheet2.Range("H3") = "=SUMIF(数据库2!BF:BF,成本计算单!$E$4&成本计算单!$E$3&$D3,BL:BL)" '(2、汇总条件设置，发生材料金额)
Sheet2.Range("H3").AutoFill Sheet2.Range("H3:H1000")

Sheet2.Range("A3") = "=IF(G3=0,0,1+MAX($A$2:A2))" '(3、以数量排序)
Sheet2.Range("A3").AutoFill Sheet2.Range("A3:A1000")

mmmm = Range("z4") '复制（4、清除公式1-2多余部分）
nnnn = Range("z5") '粘贴到数据库1的位置
p = Sheets("数据库2").Range(mmmm)
Sheets("数据库2").Range(nnnn) = p
oooo = Range("z7") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("z4") '复制（5、清除公式3多余部分）
jjjj = Range("z6") '粘贴到数据库1的位置
l = Sheets("数据库2").Range(iiii)
Sheets("数据库2").Range(jjjj) = l
kkkk = Range("z7") '粘贴到数据库1所在的区域（起始行和末行）。


Sheet4.Range("D12") = "=IF(C10=0,0,1)" '(6、汇总排序)
Sheet4.Range("D13") = "=IF(OR(D12=$C$10,D12=0),0,1+MAX($D$12:D12))" '(排序)
Sheet4.Range("D13").AutoFill Sheet4.Range("D13:D200")
  
Sheet4.Range("E12") = "=IF($D12=0,0,VLOOKUP(D12,数据库2!$A$3:$D$1000,4,FALSE))" '(7、获得名称)
Sheet4.Range("E12").AutoFill Sheet4.Range("E12:E200")

   
Sheet4.Range("F12") = "=SUMIF(数据库2!$D:$D,$E12,数据库2!G:G)" '(8、获得数量)
Sheet4.Range("F12").AutoFill Sheet4.Range("F12:F200")

   
Sheet4.Range("H12") = "=SUMIF(数据库2!$D:$D,$E12,数据库2!H:H)" '(9、金额)
Sheet4.Range("H12").AutoFill Sheet4.Range("H12:H200")

   
Sheet4.Range("G12") = "=IF(F12*H12=0,0,H12/F12)" '(10、单价)
Sheet4.Range("G12").AutoFill Sheet4.Range("G12:G200")


dddd = Range("Z9") '复制空白清除下方多余公式
eeee = Range("Z10") '粘贴到数据库1的位置
g = Sheets("成本计算单").Range(dddd)
Sheets("成本计算单").Range(eeee) = g
ffff = Range("Z11") '粘贴到数据库1所在的区域（起始行和末行）
   
   MsgBox "已经更新"
  
  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End Sub

yzxfelix

Sub 间接费用保存()

    If Sheet9.[N27] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "不在录入状态\无月份或凭证号\凭证重复\本月已分配完毕"
   
Else

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

dddd = Range("M4") '复制（1、第一项成本）
eeee = Range("M5") '粘贴到数据库1的位置
g = Sheets("间接成本录入").Range(dddd)
Sheets("数据库3").Range(eeee) = g
ffff = Range("M6") '粘贴到数据库1所在的区域（起始行和末行）。

aaaa = Range("M10") '复制（2、保存第二项成本）
bbbb = Range("M11") '粘贴到数据库1的位置
H = Sheets("间接成本录入").Range(aaaa)
Sheets("数据库3").Range(bbbb) = H
cccc = Range("M12") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("M17") '复制（3、保存第三项成本）
jjjj = Range("M18") '粘贴到数据库1的位置
l = Sheets("间接成本录入").Range(iiii)
Sheets("数据库3").Range(jjjj) = l
kkkk = Range("M19") '粘贴到数据库1所在的区域（起始行和末行）。

mmmm = Range("M22") '复制（4、保存第四项成本）
nnnn = Range("M23") '粘贴到数据库1的位置
p = Sheets("间接成本录入").Range(mmmm)
Sheets("数据库3").Range(nnnn) = p
oooo = Range("M24") '粘贴到数据库1所在的区域（起始行和末行）。

gggg = Range("S17") '从数据库2复制上月单价信息（5、保存月份号和凭证号）
hhhh = Range("S18") '粘贴到录入表
j = Sheets("间接成本录入").Range(gggg)
Sheets("数据库3").Range(hhhh) = j
iiii = Range("S19") '粘贴到分摊表的（起始行和末行）。
   

  Range("F5:H8") = "" '保存后，清除输入的数据
Range("J2") = "" '保存后，清除输入的数据
MsgBox "保存成功"

  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End If
End Sub

Sub 间接费用删除()

    If Sheet9.[N64] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "不在删除状态\有已经分配成本\"
   
Else

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

dddd = Range("M37") '复制删除（1、第一项成本）
eeee = Range("M38") '粘贴到数据库1的位置
g = Sheets("数据库3").Range(dddd)
Sheets("数据库3").Range(eeee) = g
ffff = Range("M39") '粘贴到数据库1所在的区域（起始行和末行）。

aaaa = Range("M43") '复制删除（2、保存第二项成本）
bbbb = Range("M44") '粘贴到数据库1的位置
H = Sheets("数据库3").Range(aaaa)
Sheets("数据库3").Range(bbbb) = H
cccc = Range("M45") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("M50") '复制删除（3、保存第三项成本）
jjjj = Range("M51") '粘贴到数据库1的位置
l = Sheets("数据库3").Range(iiii)
Sheets("数据库3").Range(jjjj) = l
kkkk = Range("M52") '粘贴到数据库1所在的区域（起始行和末行）。

mmmm = Range("M55") '复制删除（4、保存第四项成本）
nnnn = Range("M56") '粘贴到数据库1的位置
p = Sheets("数据库3").Range(mmmm)
Sheets("数据库3").Range(nnnn) = p
oooo = Range("M57") '粘贴到数据库1所在的区域（起始行和末行）。

gggg = Range("M60") '删除独立凭证及月份信息（5、保存月份号和凭证号）
hhhh = Range("M61") '粘贴到录入表
j = Sheets("数据库3").Range(gggg)
Sheets("数据库3").Range(hhhh) = j
iiii = Range("M62") '粘贴到分摊表的（起始行和末行）。
   
MsgBox "删除成功"

  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  
End If
End Sub

yzxfelix

Sub 材料成本录入()
If Sheet8.[H4] = "" Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "启动前输入月份号"
   
Else

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

If Sheet8.[B6] = 1 Then '如果处于直接材料录入状态，执行如下操作
dddd = Range("m4") '从数据库2复制材料名称信息（1、直接材料名称的获取设置）
eeee = Range("m5") '粘贴到录入表
g = Sheets("数据库2").Range(dddd)
Sheets("直接材料").Range(eeee) = g
ffff = Range("m6") '粘贴到分摊表的（起始行和末行）。

gggg = Range("m14") '从数据库2复制上月单价信息（2、主要材料单价）
hhhh = Range("m15") '粘贴到录入表
j = Sheets("数据库2").Range(gggg)
Sheets("直接材料").Range(hhhh) = j
iiii = Range("m16") '粘贴到分摊表的（起始行和末行）。

MsgBox "启动成功   输入数据再 确认"
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新

Else
End If
End If
End Sub

Sub 材料成本计算()

If Sheet8.[B7] <> 2 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "产品名称月份号不全"
Else
Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
   If Sheet8.[B6] = 1 Then '如果处于信息录入状态，执行如下操作
  Sheet8.Range("H10") = "=F10*G10" '（1、计算金额）
Sheet8.Range("H10").AutoFill Sheet8.Range("H10:H1000")
  
  Sheet8.Range("I10") = "=INDEX(数据库2!$O$3:$Z$1000,AD10,$H$4)+F10" '（2、计算累计数量）"
Sheet8.Range("I10").AutoFill Sheet8.Range("I10:I1000")


  Sheet8.Range("J10") = "=INDEX(数据库2!$AQ$3:$BB$1000,AD10,$H$4)+H10" '（3、计算累计金额）
Sheet8.Range("J10").AutoFill Sheet8.Range("J10:J1000")
Sheet8.Range("D10") = "=IF(H10=0,0,1+MAX($D$9:D9))" '（1、计算金额）
Sheet8.Range("D10").AutoFill Sheet8.Range("D10:D1000")

mmmm = Range("M9") '复制（4、清除计算列多余行公式）
nnnn = Range("M10") '粘贴到数据库1的位置
p = Sheets("直接材料").Range(mmmm)
Sheets("直接材料").Range(nnnn) = p
oooo = Range("M11") '粘贴到数据库1所在的区域（起始行和末行）。
  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
  Else

If Sheet8.[B6] = 2 Then '如果处于删除状态，执行如下操作
    dddd = Range("m4") '从数据库2复制材料名称信息（1、获得材料名称）
eeee = Range("m5") '粘贴到录入表
g = Sheets("数据库2").Range(dddd)
Sheets("直接材料").Range(eeee) = g
ffff = Range("m6") '粘贴到分摊表的（起始行和末行）。

gggg = Range("m14") '从数据库2复制上月单价信息（2、获得材料单价）
hhhh = Range("m15") '粘贴到录入表
j = Sheets("数据库2").Range(gggg)
Sheets("直接材料").Range(hhhh) = j
iiii = Range("m16") '粘贴到分摊表的（起始行和末行）。
   
    Sheet8.Range("F10") = "=-SUMIF(数据库2!$BF$3:$BF$10000,$H$4&$E$4&E10,数据库2!$BK$3:$BK$10000)" '（3、计算负数量准备冲减）
Sheet8.Range("F10").AutoFill Sheet8.Range("F10:F1000")
   Sheet8.Range("H10") = "=-SUMIF(数据库2!$BF$3:$BF$10000,$H$4&$E$4&E10,数据库2!$BL$3:$BL$10000)" '（4、计算负金额准备冲减）
Sheet8.Range("H10").AutoFill Sheet8.Range("H10:H1000")
  Sheet8.Range("I10") = "=INDEX(数据库2!$O$3:$Z$1000,AD10,$H$4)+F10" '（5、计算累计数量）
Sheet8.Range("I10").AutoFill Sheet8.Range("I10:I1000")
  Sheet8.Range("J10") = "=INDEX(数据库2!$AQ$3:$BB$1000,AD10,$H$4)+H10" '（6、计算累计金额）
Sheet8.Range("J10").AutoFill Sheet8.Range("J10:J1000")
Sheet8.Range("D10") = "=IF(H10=0,0,1+MAX($D$9:D9))" '（7、获得有成本材料序号）
Sheet8.Range("D10").AutoFill Sheet8.Range("D10:D1000")

mmmm = Range("M9") '复制（8、清除计算列多余行公式）
nnnn = Range("M10") '粘贴到数据库1的位置
p = Sheets("直接材料").Range(mmmm)
Sheets("直接材料").Range(nnnn) = p
oooo = Range("M11") '粘贴到数据库1所在的区域（起始行和末行）。
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
End If
End If
End If
End Sub

Sub 材料信息保存()

If Sheet8.[M40] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "可能操作选项不符\信息不全\凭证重复\没有保存或删除数据\成本已经分配完毕"
   
Else
Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

dddd = Range("m21") '（1、保存数量设置；复制）
eeee = Range("m22") '粘贴到录入表
g = Sheets("直接材料").Range(dddd)
Sheets("数据库2").Range(eeee) = g
ffff = Range("m23") '粘贴到分摊表的（起始行和末行）。

gggg = Range("m26") '复制单价信息（2、保存单价设置）
hhhh = Range("m27") '粘贴到录入表
j = Sheets("直接材料").Range(gggg)
Sheets("数据库2").Range(hhhh) = j
iiii = Range("m28") '粘贴到分摊表的（起始行和末行）。

aaaa = Range("m31") '复制金额信息（3、保存金额信息设置）
bbbb = Range("m32") '粘贴到录入表
c = Sheets("直接材料").Range(aaaa)
Sheets("数据库2").Range(bbbb) = c
dddd = Range("m33") '粘贴到分摊表的（起始行和末行）。
  Range("D10:J10000") = "" '保存后，清除输入的数据
If Sheet8.[B6] = 1 Then '如果处于删除状态，执行如下操作
  aaaa = Range("m36") '复制金额信息（4、保存单品材料信息设置）
bbbb = Range("m37") '粘贴到录入表
c = Sheets("直接材料").Range(aaaa)
Sheets("数据库2").Range(bbbb) = c
dddd = Range("m38") '粘贴到分摊表的（起始行和末行）。
    Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
     
   Else
aaaa = Range("m36") '复制金额信息（4、保存单品材料信息设置）
bbbb = Range("m37") '粘贴到录入表
c = Sheets("数据库2").Range(aaaa)
Sheets("数据库2").Range(bbbb) = c
dddd = Range("m38") '粘贴到分摊表的（起始行和末行）。

MsgBox "操作成功"
   Range("D10:J10000") = "" '保存后，清除输入的数据

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
End If
  End If
End Sub

yzxfelix

Sub 名称初始化()

    If Sheet5.[O4] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "保存的名称 数据库中已存在"
   
Else

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

If Sheet5.[B8] = 1 Then '1、产品名称初始化设置
dddd = Range("O10") '复制新增产品名称区域
eeee = Range("O11") '粘贴到数据库1的位置
g = Sheets("项目初始化").Range(dddd)
Sheets("数据库1").Range(eeee) = g
ffff = Range("O12") '粘贴到数据库1所在的区域（起始行和末行）。
Range("D5:E24") = "" '保存后，清除输入的数据
MsgBox "保存成功"

Sheet1.Range("C3") = "=COUNTA($D$3:D3)" '对数据库1中产品名称自动排序
Sheet1.Range("C3").AutoFill Sheet1.Range("C3:C1000") '同上

llll = Range("O14") '以下为对无名称的排序公式的清除
mmmm = Range("O15") '同上
o = Sheets("数据库1").Range(llll)
Sheets("数据库1").Range(mmmm) = o
nnnn = Range("O16")

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else

If Sheet5.[B8] = 2 Then '2、主要材料初始化设置
hhhh = Range("O10") '复制主材名称
iiii = Range("O11") '粘贴到数据库2的位置
k = Sheets("项目初始化").Range(hhhh)
Sheets("数据库2").Range(iiii) = k
jjjj = Range("O12") '粘贴到数据库2所在的区域（起始行和末行）。
Range("D5:E24") = "" '保存后，清除输入的数据
MsgBox "保存成功"
  
  Sheet2.Range("C3") = "=COUNTA($D$3:D3)" '对主材料名称自动排序
Sheet2.Range("C3").AutoFill Sheet2.Range("C3:C1000") '同上
llll = Range("O14") '以下为对无名称的排序公式的清除
mmmm = Range("O15") '同上
o = Sheets("数据库2").Range(llll)
Sheets("数据库2").Range(mmmm) = o
nnnn = Range("O16")
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else

If Sheet5.[B8] = 3 Then '3、辅助材料初始化设置
hhhh = Range("O10") '复制辅助材料名称
iiii = Range("O11") '粘贴到数据库的位置
k = Sheets("项目初始化").Range(hhhh)
Sheets("数据库3").Range(iiii) = k
jjjj = Range("O12") '粘贴到数据库所在的区域（起始行和末行）。
Range("D5:E24") = "" '保存后，清除输入的数据
MsgBox "保存成功"

Sheet3.Range("C3") = "=COUNTA($D$3:D3)" '对辅助材料名称自动排序
Sheet3.Range("C3").AutoFill Sheet3.Range("C3:C1000") '同上
llll = Range("O14") '以下为对无名称的排序公式的清除
mmmm = Range("O15") '同上
o = Sheets("数据库3").Range(llll)
Sheets("数据库3").Range(mmmm) = o
nnnn = Range("O16")
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else
End If
End If
End If
End If
End Sub

Sub 名称删除()

    If Sheet5.[O20] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "名称已经被系统使用"
   Else
MsgBox "请 输入密码后再确认" '清除前提示
Sheet5.[K9] = "输入删除密码"
If Sheet5.[K10] <> 201688 Then ' '输入密码的条件
  Else


Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

If Sheet5.[B8] = 1 Then '1、产品名称初始化设置
dddd = Range("O26") '复制新增产品名称区域
eeee = Range("O27") '粘贴到数据库1的位置
g = Sheets("数据库1").Range(dddd)
Sheets("数据库1").Range(eeee) = g
ffff = Range("O28") '粘贴到数据库1所在的区域（起始行和末行）。
Range("I5:I24") = "" '保存后，清除输入的数据
Range("K9:K10") = "" '保存后，清除输入的数据
MsgBox "删除成功"

Sheet1.Range("C3") = "=COUNTA($D$3:D3)" '对数据库1中产品名称自动排序
Sheet1.Range("C3").AutoFill Sheet1.Range("C3:C1000") '同上
llll = Range("O14") '通过复制数据库1空行，清除名称排序的无用下拉公式
mmmm = Range("O15") '同上
o = Sheets("数据库1").Range(llll)
Sheets("数据库1").Range(mmmm) = o
nnnn = Range("O16")

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else

If Sheet5.[B8] = 2 Then '1、产品名称初始化设置
dddd = Range("O26") '复制新增产品名称区域
eeee = Range("O27") '粘贴到数据库1的位置
g = Sheets("数据库2").Range(dddd)
Sheets("数据库2").Range(eeee) = g
ffff = Range("O28") '粘贴到数据库1所在的区域（起始行和末行）。
Range("I5:I24") = "" '保存后，清除输入的数据
Range("K9:K10") = "" '保存后，清除输入的数据
MsgBox "删除成功"

Sheet2.Range("C3") = "=COUNTA($D$3:D3)" '对数据库1中产品名称自动排序
Sheet2.Range("C3").AutoFill Sheet2.Range("C3:C1000") '同上
llll = Range("O14") '通过复制数据库1空行，清除名称排序的无用下拉公式
mmmm = Range("O15") '同上
o = Sheets("数据库2").Range(llll)
Sheets("数据库2").Range(mmmm) = o
nnnn = Range("O16")

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else

If Sheet5.[B8] = 3 Then '1、产品名称初始化设置
dddd = Range("O26") '复制新增产品名称区域
eeee = Range("O27") '粘贴到数据库1的位置
g = Sheets("数据库3").Range(dddd)
Sheets("数据库3").Range(eeee) = g
ffff = Range("O28") '粘贴到数据库1所在的区域（起始行和末行）。
Range("I5:I24") = "" '保存后，清除输入的数据
Range("K9:K10") = "" '保存后，清除输入的数据
MsgBox "删除成功"

Sheet3.Range("C3") = "=COUNTA($D$3:D3)" '对数据库1中产品名称自动排序
Sheet3.Range("C3").AutoFill Sheet3.Range("C3:C1000") '同上
llll = Range("O14") '通过复制数据库1空行，清除名称排序的无用下拉公式
mmmm = Range("O15") '同上
o = Sheets("数据库3").Range(llll)
Sheets("数据库3").Range(mmmm) = o
nnnn = Range("O16")

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
Else
End If
End If
End If
End If
End If
End Sub

yzxfelix

Sub 完工录入()

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算
If Sheet7.[A11] <> 2 Then '
dddd = Range("m4") '从数据库1复制产品名称信息（1、基础信息的获取设置）
eeee = Range("m5") '粘贴到分摊表
g = Sheets("数据库1").Range(dddd)
Sheets("完工录入").Range(eeee) = g
ffff = Range("m6") '粘贴到分摊表的（起始行和末行）。
Sheet7.Range("D10") = "=IF($D$7=5,SUMIF(数据库2!BE:BE,$H$4&C10,数据库2!BL:BL),IF($D$7=4,E10,0))" '（'2按照分配方法获得材料成本或数量基数）
Sheet7.Range("D10").AutoFill Sheet7.Range("D10:D1000")

MsgBox "启动成功   输入数据再  确认"
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新

If Sheet7.[E9] <> 0 Then '（2、各项目分摊公式及其向下复制）

Sheet7.Range("F10") = "=If($D$9=0,0,$D$3/$D$9*$D10)" '燃料动力
Sheet7.Range("F10").AutoFill Sheet7.Range("F10:F1000")
Sheet7.Range("G10") = "=If($D$9=0,0,$D$4/$D$9*$D10)" '人工
Sheet7.Range("G10").AutoFill Sheet7.Range("G10:G1000")
Sheet7.Range("H10") = "=If($D$9=0,0,$D$5/$D$9*$D10)" '制造费
Sheet7.Range("H10").AutoFill Sheet7.Range("H10:H1000")
Sheet7.Range("I10") = "=If($D$9=0,0,$D$6/$D$9*$D10)" '辅助材料
Sheet7.Range("I10").AutoFill Sheet7.Range("I10:I1000")

                           
hhhh = Range("m9") ' 复制空白  (3、清除向下复制中，没有数据的无效区域)
iiii = Range("m10") '粘贴到无数据的位置
k = Sheets("完工录入").Range(hhhh)
Sheets("完工录入").Range(iiii) = k
jjjj = Range("m11") '粘贴的区域（起始行和末行）
Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
   Else
End If
End If
End Sub

Sub 分摊成本保存()

    If Sheet7.[M35] <> 0 Then '  为防止差错设置的控制条件。如果发生控制内容，执行如下命令。
MsgBox "本月已保存\或无成本数据\或处于删除\或删除状态无数据/或无记账凭证号"
   
Else

Application.ScreenUpdating = False                  '关闭屏幕刷新
Application.Calculation = xlCalculationManual       '手动重算

dddd = Range("M15") '复制（1、保存工时信息）
eeee = Range("M16") '粘贴到数据库1的位置
g = Sheets("完工录入").Range(dddd)
Sheets("数据库1").Range(eeee) = g
ffff = Range("M17") '粘贴到数据库1所在的区域（起始行和末行）。

aaaa = Range("M19") '复制（2、保存产量信息）
bbbb = Range("M20") '粘贴到数据库1的位置
H = Sheets("完工录入").Range(aaaa)
Sheets("数据库1").Range(bbbb) = H
cccc = Range("M21") '粘贴到数据库1所在的区域（起始行和末行）。

iiii = Range("M23") '复制（3、保存燃料动力）
jjjj = Range("M24") '粘贴到数据库1的位置
l = Sheets("完工录入").Range(iiii)
Sheets("数据库1").Range(jjjj) = l
kkkk = Range("M25") '粘贴到数据库1所在的区域（起始行和末行）。

mmmm = Range("M27") '复制（4、保存人工）
nnnn = Range("M28") '粘贴到数据库1的位置
p = Sheets("完工录入").Range(mmmm)
Sheets("数据库1").Range(nnnn) = p
oooo = Range("M29") '粘贴到数据库1所在的区域（起始行和末行）。

qqqq = Range("M31") '复制（5、保存制造费）
rrrr = Range("M32") '粘贴到数据库1的位置
t = Sheets("完工录入").Range(qqqq)
Sheets("数据库1").Range(rrrr) = t
ssss = Range("M33") '粘贴到数据库1所在的区域（起始行和末行）。

uuuu = Range("Q31") '复制（6、保存辅助材料）
vvvv = Range("Q32") '粘贴到数据库1的位置
x = Sheets("完工录入").Range(uuuu)
Sheets("数据库1").Range(vvvv) = x
wwww = Range("Q33") '粘贴到数据库1所在的区域（起始行和末行）。

uuuu = Range("M47") '复制总成本项目信息（7、保存总成本及凭证号）
vvvv = Range("M48") '粘贴到数据库1的位置
x = Sheets("完工录入").Range(uuuu)
Sheets("数据库1").Range(vvvv) = x
wwww = Range("M49") '粘贴到数据库1所在的区域（起始行和末行）。
  Range("B10:I1000") = "" '保存后，清除输入的数据
Range("F3") = "" '保存后，清除输入的数据
MsgBox "操作成功"

  Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
   
If Sheet7.[A11] = 2 Then '删除产品成本(在删除状态执行以下操作)
uuuu = Range("m51") '复制（复制数据库产品成本项目中删除行以下数据上移）
vvvv = Range("m52") '粘贴到删除的数据区域，达到即删除月份数据，又使数据库空行被剔除
y = Sheets("数据库1").Range(uuuu)
Sheets("数据库1").Range(vvvv) = y
wwww = Range("m53") '粘贴到数据库1所在的区域（起始行和末行）。

Application.Calculation = xlCalculationAutomatic    '自动重算
Application.ScreenUpdating = True                   '打开屏幕刷新
End If
End If
End Sub

yzxfelix

感觉大家感兴趣，代码贴上去。希望能喜欢