Office中国论坛/Access中国论坛

标题: [已解决]条件未达到，给出消息框，程序退出 [打印本页]
作者: hannanrenjie    时间: 2017-7-29 13:14
标题: [已解决]条件未达到，给出消息框，程序退出
本帖最后由 hannanrenjie 于 2017-7-29 14:33 编辑

今天在EXCEL财务系统中，录入凭证，不小心将某个科目的发生数据录错。
那么，此时保存凭证记录，必定会给后续计算核对成错误。重新逐笔核对，工作量就很大了。
怎么办，在按钮事件中加上，判断借贷平衡。不平衡则提示，并退出程序。
由于年纪大了不好意思问人，就自己乱画，一试居然还起作用，就是太起作用了--不管是否相等，它都给出一个“不平衡的消息，退出了---后面的程序也不执行了。请老师帮助一下我这个老学生吧：
不平衡的时候，给个消息，确定后退出。平衡时，就复制粘贴数据到”凭证明细“表最后一行。
Sub 凭证提交新()
   Sheets("凭证录入").Select
   ActiveSheet.Calculate  '计算工作表，便于设置为手动计算表中，数据更新。
    If [M16] <> [I16] Then   '加个借贷平衡判断，两个单元格分别是会计凭证借方贷方合计。
      MsgBox "借贷不平衡，请检查！"
      End
    End If
      Exit Sub ' 不平衡则退出程序。
       以下略。。。。
    Dim a As Long
    Set s = ActiveSheet.Range("A6:A15")
    For Each rg In s
        If rg = "" Then
            a = rg.Row - 1   '减一行后下面不粘贴空行。
            Exit For
        End If





作者: Henry D. Sy    时间: 2017-7-29 13:41
  1. &nbsp; If [M16] <> [I16] Then&nbsp; &nbsp;'加个借贷平衡判断，两个单元格分别是会计凭证借方贷方合计。
  2. &nbsp; &nbsp;&nbsp; &nbsp;MsgBox "借贷不平衡，请检查！"
  3. &nbsp; &nbsp;&nbsp; &nbsp;Exit Sub
  4. &nbsp; &nbsp; End If
复制代码
作者: Henry D. Sy    时间: 2017-7-29 13:42
  1. If [M16] <> [I16] Then
  2.         MsgBox "借贷不平衡，请检查！"
  3.         Exit Sub
  4.     End If
复制代码
作者: tmtony    时间: 2017-7-29 13:45
什么EXCEL财务系统 ，上传一个来瞧瞧？
作者: hannanrenjie    时间: 2017-7-29 13:55
Henry D. Sy 发表于 2017-7-29 13:41

刚才没上传附件，请问写在哪里呢？
作者: hannanrenjie    时间: 2017-7-29 14:00
tmtony 发表于 2017-7-29 13:45
什么EXCEL财务系统 ，上传一个来瞧瞧？

是个简单的录制凭证的小程序，与账簿（在其他工作簿中）共同组成一个凭证录入 ，报表生成，科目查询，账簿展现的需求。
既然被老师遇到，就麻烦拿出你的牛刀来吧
不平衡直接的退出，平衡不用提示，执行完程序。不知道在哪里写开始的IF中止的IF。
作者: Henry D. Sy    时间: 2017-7-29 14:18
本帖最后由 Henry D. Sy 于 2017-7-29 14:21 编辑
hannanrenjie 发表于 2017-7-29 13:55
刚才没上传附件，请问写在哪里呢？
  1. <font style="background-color: rgb(255, 255, 255);">Sub 凭证提交新()
  2.     ' 凭证提交新，EXCEL精英网chart888网友帮助修改 http://www.excelpx.com/forum.php?mod=viewthread&tid=431463&page=1#pid4141379
  3.     '
  4.     Sheets("凭证录入").Select
  5.     ActiveSheet.Calculate  '计算工作表，便于设置为手动计算表中，数据更新。
  6.     If [M16] <> [O16] Then '加个借贷平衡判断。
  7.         MsgBox "借贷不平衡，请检查！"
  8.         Exit Sub
  9.     End If
  10.     Dim a As Long
  11.     Set s = ActiveSheet.Range("A6:A15")
  12.     For Each rg In s
  13.         If rg = "" Then
  14.             a = rg.Row - 1   '减一行后下面不粘贴空行。
  15.             Exit For
  16.         End If
  17.     Next
  18.     Range("A6:O" & a).Select
  19.     Selection.Copy
  20.     Sheets("凭证明细").Select
  21.     Dim b As Long
  22.     b = Sheets("凭证明细").[a65536].End(xlUp).Row + 1
  23.     Sheets("凭证明细").Select
  24.     Sheets("凭证明细").Cells(b, 1).Select
  25.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  26.         :=False, Transpose:=False
  27.     ActiveSheet.Calculate  '计算工作表，便于设置为手动计算表中，数据更新。
  28.     Sheets("凭证录入").Select
  29.     ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  '无密码保护工作表，
  30.    
  31.     '    Exit Sub ' 不平衡则退出程序。
  32. End Sub</font>
复制代码


注意是O16,不是I16
作者: hannanrenjie    时间: 2017-7-29 14:32
Henry D. Sy 发表于 2017-7-29 14:18
注意是O16,不是I16

还是版主细心，成功源于细节啊！谢谢了！哪个地方评最优答案?
作者: Henry D. Sy    时间: 2017-7-29 14:33
建议最后加上去掉复制模式

[attach]61800[/attach]

  1. Application.CutCopyMode = False
  2.     Range("O24").Select
复制代码
作者: Henry D. Sy    时间: 2017-7-29 14:35
我的回复怎么被自动删掉了,
可能又是非法代码!!



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3