请大家讨论工资软件中工资公式计算如何实现

Question

你用个文本让他们写公式，然后直接包公式存到数据库中！
运算时读取公式运算，前段时间刚帮人用递归的方法实现读公式运算，贴给你参考！
Option Explicit
Dim strgsxm As String
Dim strgetchild As String
Dim sql As StringPrivate Sub GetChild(Str As String)
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim y As Integer
Dim i As Integer
Dim strtempjsgs As String
Dim strgschar As String
Dim findgs As Boolean
findgs = False
'conn.ConnectionString = "DBQ=data\rsgz.mdb;DRIVER={Microsoft Access Driver (*.mdb)};"
conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=fornet;Data Source=computer"
sql = "select 计算公式 from SYSTABLEINFO where len(计算公式)>0 and 字段名称='" & Str & "'"
rs.Open sql, conn, adOpenStatic, adLockReadOnly
If Not (rs.EOF And rs.BOF) Then                        '如果找到计算公式
  rs.MoveFirst
  strtempjsgs = Trim$(rs("计算公式"))                  '存储计算公式到变量
  y = Len(strtempjsgs) + 1
  If strtempjsgs <> "" Then                            '如果公式有效
    strgsxm = ""                                       '初始化计算公式的公式项目
    For i = 1 To y                                     '循环取出计算公式的每个字符
      strgschar = Mid(strtempjsgs, i, 1)                '取当前字符
      If InStr("+-*/()", strgschar) > 0 Then           '如果当前字符是运算符
        If strgsxm <> "" Then                          '如果公式项目有效则继续查找
          Call GetChild(Trim$(strgsxm))                '递归查找此公式项的计算公式
          strgsxm = ""                                 '重置公式项目变量
        End If
        strgetchild = strgetchild & strgschar          '运算符存入整理后的标准公式
      Else
        strgsxm = strgsxm & strgschar                  '如果当前字符不是运算符则拼接成计算公式项目
      End If
    Next i
  End If
Else
  strgetchild = strgetchild & Str                      '当前公式项目存入标准公式
End If
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
End Sub测试项目: Str = 岗位扣款
背景:
岗位扣款 = (病假天数 + 旷工事假工资) * 3
旷工事假工资 = (技能工资 / 20.92) * 旷工事假天数
标准公式应为 (程序运行应得结果):
(病假天数+（技能工资/20.92）*旷工事假天数)*3  ‖天天写程序‖    ‖夜夜泡小妞‖
‖身兼数职做代码‖‖晚晚工作到天明‖
‖为何人生如此苦‖‖泡妞消费数目高‖
‖我看世俗本无趣‖‖程序伤神妞伤人‖
  ‖不再见女人‖    ‖不想写程序‖

Answer 1

我如何提取公式中的数据，呢？能否给个详细思路，用变量还是SELECT语句？
我想实现：当我输入病假天数的值到一个TEXTBOX，另一个TEXTBOX会立刻显示岗位扣款的值出来？

Answer 2

Private Sub Command1_Click()
Dim sname As String, cds As String, sexs As Integer, sfzs As String
Dim dahs As String, jszs As String, csrqs As String, lzrqs As String
Dim jfrqs As String, nds As String
sname = xm.Text
If Trim(xm) = "" Then
  MsgBox "姓名不能为空！"
  xm.SetFocus
  Exit Sub
End If
cds = cd.Text
If Trim(cds) = "" Then
  MsgBox "车队不能为空！"
  cd.SetFocus
  Exit Sub
End If
sexs = sex.ListIndex
If sexs < 0 Then
MsgBox "性别不能为空！"
  sex.SetFocus
  Exit Sub
End If
sfzs = sfz.Text
If Trim(sfzs) = "" Then
  MsgBox "身份证不能为空！"
  sfz.SetFocus
  Exit Sub
  Else
  If Len(sfzs) <> 15 And Len(sfzs) <> 18 Then
  MsgBox "身份证位数不对！"
  sfz.SetFocus
  Exit Sub
  End If
End If
jszs = jsz.Text
If Trim(jszs) = "" Then
  MsgBox "驾驶证不能为空！"
  jsz.SetFocus
  Exit Sub
  
  
End If
dahs = dah.Text
If Trim(dahs) = "" Then
  MsgBox "档案号不能为空！"
  dah.SetFocus
  Exit Sub
End If
csrqs = csrq.Text
If Trim(lzrqs) <> "" Then
  If Not IsDate(lzrqs) Then
     MsgBox "领证日期输入不正确！"
     lzrq.SetFocus
     Exit Sub
  End If
End If
lzrqs = csrq.Text
If Trim(csrqs) <> "" Then
  If Not IsDate(csrqs) Then
     MsgBox "出生日期输入不正确！"
     csrq.SetFocus
     Exit Sub
  End If
End If
jfrqs = jfrq.Text
If Trim(jfrqs) <> "" Then
  If Not IsDate(jfrqs) Then
     MsgBox "交费日期输入不正确！"
     jfrq.SetFocus
     Exit Sub
  End If
End If
  nds = nd.Text
If Trim(nds) = "" Then
    MsgBox "年度不能为空！"
    Exit Sub
    nd.SetFocus
    
    Else
    If Not IsNumeric(nds) Then
     MsgBox "年度应为数字！"
     nd.SetFocus
    Exit Sub
    End If
End If
Dim rs As New ADODB.Recordset
Err.clear
On Error GoTo errorhandler
rs.Open "select * from chgb where 1<>1", conn, 1, 3
conn.BeginTrans
rs.AddNew
rs("sname") = sname
'Dim rs1 As New ADODB.Recordset
'rs1.Open "select * from cdb where sname='" + cds + "'", conn
rs("cd") = cds
'rs1.Close
'Set rs1 = Nothing
rs("sex") = sexs
If Trim(csrqs) <> "" Then
rs("csny") = csrqs
End If
rs("jg") = jg
rs("jdzz") = jtdh.Text
rs("sfz") = sfzs
rs("jsz") = jszs
jszs = grdh.Text
'If Trim(jszs) <> "" Then
rs("grtx") = grdh
'End If
rs("dah") = dahs
If Trim(lzrqs) <> "" Then
rs("lzrq") = lzrqs
End If
jszs = dwdz.Text
'If Trim(jszs) <> "" Then
rs("dwdz") = jszs
'End If
If Trim(jfrqs) <> "" Then
rs("jfsj") = jfrqs
End If
rs("jf") = jf.Text
jszs = dwdh.Text
'If Trim(jszs) <> "" Then
rs("dwdh") = jszs
'End If
jszs = jsjl.Text
'If Trim(jszs) <> "" Then
rs("jsjl") = jszs
'End If
jszs = mem.Text
'If Trim(jszs) <> "" Then
rs("mem") = jszs
'End If
rs("nd") = nds
rs.Update
conn.CommitTrans
rs.Close
Set rs = Nothing
MsgBox "增加成功！"
clear
Exit Sub
errorhandler:
If Err.Number = -2147217873 Then
 MsgBox "键值已存在！"
 Else
  MsgBox "记录增加出错：" & Err.Description & " 错误号：" & Err.Number
End If
conn.RollbackTrans
conn.Errors.clear
rs.Close
Set rs = Nothing
End Sub