|
我自己编了代码:
Sub 出库()
Dim a, zh
Dim rjr, rsl, cjr, csl, dm, rq, kcj, kcs, qcj, qcs, bcj, bcs
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("总表")
zh = Sheets("总表").Range("c65536").End(xlUp).Row '最大行数
For a = 4 To zh 'zh
Set dm = .Range("C4:C" & zh)
Set rq = .Range("A4:A" & zh)
Set rjr = .Range("I4:I" & zh)
Set rsl = .Range("G4:G" & zh)
Set cjr = .Range("N4:N" & zh)
Set csl = .Range("J4:J" & zh)
qcj = WorksheetFunction.Round(Application.WorksheetFunction.SumIfs(rjr, dm,.Cells(a, 3), rq, "<" & .Cells(a, 1)) - Application.WorksheetFunction.SumIfs(cjr, dm, .Cells(a, 3), rq, "<" & .Cells(a, 1)), 2)
bcj = WorksheetFunction.Round(Application.WorksheetFunction.SumIfs(rjr, dm, .Cells(a, 3), rq, "=" &.Cells(a, 1)), 2)
kcj = qcj + bcj
.Cells(a, 16) = kcj
qcs = WorksheetFunction.Round(Application.WorksheetFunction.SumIfs(rsl, dm, .Cells(a, 3), rq, "<" & .Cells(a, 1)) - Application.WorksheetFunction.SumIfs(csl, dm, .Cells(a, 3), rq, "<" &.Cells(a, 1)), 0)
bcs = WorksheetFunction.Round(Application.WorksheetFunction.SumIfs(rsl, dm, .Cells(a, 3), rq, "=" & .Cells(a, 1)), 0)
kcs = qcs + bcs
.Cells(a, 15) = kcs
If kcj = 0 Or kcs = 0 Then
.Cells(a, 13) = .Cells(a, 11) * 0.75
Else
.Cells(a, 13) = kcj / kcs
End If
If .Cells(a, 10) <> "" Then
.Cells(a, 14) = .Cells(a, 10) * .Cells(a, 13)
Else
.Cells(a, 14) = 0
End If
Next a
End With
MsgBox "存货出库成本已核算完毕!"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
我标红的起不了作用,所以计算不出来我想要的结果.
具体要求我在附件中做了详细说明。
请各位老师帮忙看看有没有更好的解决方案!谢谢!!
|
|