[已解决]求助-一个表单的数据录入后，如何根据条件进行相应处理？

sq_cheng · 发表于 2012-1-12 23:01

我有几张表格，在“录入表格”里输入金额后，能自动根据以下条件进行处理，条件是该金额+当月实际已发生的费用如果小于预算，就用该金额+当月实际已发生的费用的和更新对应部门表单里的当月实际费用。如果超过预算，就提示超过预算并不更新数据。
比如：
当财务部的用户在F4单元格录入1月差旅费金额500元时，财务部的差旅费1月预算是2000元(单元格O7)，这次发生金额500元加上1月实际发生费用300<2000，在预算内，就将500+300=800元就更新到财务部表单的1月实际费用(单元格C7）。
但如果累计金额超过预算，就弹出对话框提示费用超预算并不更新数据。

请帮忙各位高手看看该如何写这个程序？谢谢！

样表.zip (7.36 KB, 下载次数: 5)

sunjing-zxl · 发表于 2012-1-13 10:21

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

本帖最后由 sunjing-zxl 于 2012-1-13 10:22 编辑

Sub aa()
Dim arr1, arr2, arr3
Dim i As Long, j As Long, n As Long
Dim bm As String
arr1 = Range("A4:F" & [A65536].End(xlUp).Row)
n = Month(Cells(1, 2))
For i = 1 To UBound(arr1)
If arr1(i, 3) = "" Then
Exit For
Else
bm = arr1(i, 3)
With Sheets(bm)
arr2 = .Range(.Cells(3, 1), .Cells(.[A65536].End(xlUp).Row, 14))
arr3 = .Range(.Cells(3, 15), .Cells(.[A65536].End(xlUp).Row, 26))
End With
End If
For j = 1 To UBound(arr2)
If arr1(i, 1) = arr2(j, 1) Then
If arr2(j, n + 2) + arr1(i, 6) > arr3(j, n) Then
MsgBox arr1(i, 3) & arr1(i, 1) & "费用超预算并不更新数据"
Else
Sheets(bm).Cells(j + 2, n + 2) = arr2(j, n + 2) + arr1(i, 6)
MsgBox arr1(i, 3) & arr1(i, 1) & "费用更新至" & arr2(j, n + 2) + arr1(i, 6)
End If
Exit For
End If
Next j
Next i
MsgBox "数据更新完成"
End Sub

复制代码

附件：

样表-sunjing.rar (13.64 KB, 下载次数: 22)

sq_cheng · 发表于 2012-1-13 10:45

谢谢Sunjing，能实现我想要的功能。再次感谢！

		自动登录	找回密码
密码			注册

[已解决]求助-一个表单的数据录入后，如何根据条件进行相应处理？

相关帖子