在VFP中如何解析公式自动计算结果?

hb_123456 2005-10-18 09:05:40
在银行经常用科目号中,如“1110”代表现金,“5110”代表收入,等等,上述科目月底有余额,但会计报表生成过程中经常在科目之间进行四则运算。例如:在科目余额表中,“1110”科目余额:100万元,“1120”科目余额350万元,“1170科目余额400万元“,现公式中表达式为“1110+1120-1170”,其结果应为50万元,在VFP中如何解析公式并高效查询科目余额,最后自动计算结果?
...全文
371 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
hb_123456 2005-10-31
  • 打赏
  • 举报
回复
PARAMETERS mysumstr
*判断是否/0
m.myyes=.f.
LOCAL m.i, m.myzero_num,j,m.myzero_str, mychar
IF "/" $ mysumstr

m.i=1
m.myzero_num=AT("/",mysumstr,m.i)
DO WHILE m.myzero_num>0
m.j=1
m.myzero_str=""
DO WHILE .T.
*IF "7541387.43" $ m.myzero_str
*susp
*ENDIF
mychar=SUBSTR(mysumstr,m.myzero_num+m.j,1)
IF ISDIGIT( mychar) OR mychar="." THEN
m.myzero_str=m.myzero_str+mychar
ENDIF
IF mychar="(" AND m.j=1
m.myzero_str=m.myzero_str+mychar
endif
IF "(" $ m.myzero_str AND INLIST(m.mychar,"+","-","*","/",SPACE(1))

m.myzero_str=m.myzero_str+mychar
endif
IF "(" $ m.myzero_str AND m.mychar=")"
m.myzero_str=m.myzero_str+mychar
IF eval(m.myzero_str)=0
m.myyes=.T.

ENDIF
EXIT
endif



IF (not("(" $ m.myzero_str) AND INLIST(m.mychar,"+","-","*","/",SPACE(1),")")) OR m.myzero_num+m.j>LEN(mysumstr)
IF empty(m.myzero_str)
EXIT
endif


IF eval(m.myzero_str)=0
m.myyes=.T.

ENDIF
EXIT
ENDIF

IF m.myzero_num+m.j>LEN(mysumstr)
EXIT
ENDIF
m.j=m.j+1
ENDDO
**dhgfffffffffffffffff
m.i=m.i+1
m.myzero_num=AT("/",mysumstr,m.i)
ENDDO
ENDIF
RETURN m.myyes
hb_123456 2005-10-31
  • 打赏
  • 举报
回复
PARAMETERS m.dh,m.dhyef,m.myexp,m.myrq
LOCAL m.myflag,m.mykmh,m.myye,mopertor,m.i,m.myexp_len,m.mychar,m.mysumstr,m.myyef,myrecno

IF EMPTY(m.myexp)
RETURN 0
ENDIF
m.myworkarea=SELECT()
m.myexp=STRTRAN(m.myexp,SPACE(1),"")+SPACE(2)
IF USED("tmpkmyeb")
USE IN tmpkmyeb
ENDIF
CREATE TABLE tmpkmyeb FREE (kmh c(8),ye N(16,2),yef c(1),rq d,opertor c(1),FLAG c(1))
*CREATE TABLE tmpkmyeb FREE (kmh c(8),ye N(16,2),yef c(1),rq d,opertor c(1))

m.myyef="#"
m.mykmh=""
m.myye=0
m.myopertor=""
m.i=1
m.myexp_len=LEN(myexp)
DO WHILE m.i< m.myexp_len
m.mychar=SUBSTR(m.myexp,m.i,1)
IF m.mychar="["
DO CASE
&&借方余额
CASE SUBSTR(myexp,m.i+1,1)="J" OR SUBSTR(myexp,m.i+1,1)="5"

m.myyef="5"
&&贷方余额
CASE SUBSTR(myexp,m.i+1,1)="D" OR SUBSTR(myexp,m.i+1,1)="6"
m.myyef="6"
CASE SUBSTR(myexp,m.i+1,1)="3"
m.myyef="3"
CASE SUBSTR(myexp,m.i+1,1)="4"
m.myyef="4"
CASE SUBSTR(myexp,m.i+1,1)="C"

m.myyef="C"
CASE SUBSTR(myexp,m.i+1,2)="T3"
m.myyef="7"
*!* *本年贷方累计
CASE SUBSTR(myexp,m.i+1,2)="T4"
m.myyef="8"
CASE SUBSTR(myexp,m.i+1,1)="R"
m.myyef="R"
CASE SUBSTR(myexp,m.i+1,1)="X"
m.myyef="X"
OTHERWISE
m.myyef="+"
ENDCASE
** wait windows SUBSTR(m.myexp,m.i+1,LEN(m.myexp)-m.i)+"****"+STR(AT(SUBSTR(m.myexp,m.i+1,LEN(m.myexp)-m.i),"]"))
m.i=m.i+AT("]",SUBSTR(m.myexp,m.i+1, m.myexp_len-m.i))
m.mykmh=""
IF m.i=0
EXIT
ELSE
m.i=m.i+1
ENDIF
ENDIF
mychar=SUBSTR(myexp,m.i,1)


IF ISDIGIT( mychar) OR mychar="." THEN
m.mykmh=m.mykmh+ mychar
ENDIF
IF INLIST(m.mychar,"+","-","*","/","(",")",SPACE(1))
m.myopertor=m.mychar
***************************************
m.myrecno=RECNO("zbdata")
m.myflag=LOOKUP(zbdata.yef,m.mykmh,zbdata.dh,"dh")
GO m.myrecno IN zbdata
********************************

INSERT INTO tmpkmyeb (kmh ,ye,yef,opertor,rq) VALUES(m.mykmh,0,m.myyef,m.myopertor,m.myrq)
m.myyef="#"

m.mykmh=""
m.myye=0
m.myopertor=""
ENDIF
m.i=m.i+1
ENDDO

SELECT Tmpkmyeb.*, zbdata.dh AS kmh00, zbdata.yef AS yef00, zbdata.ye AS ye00, zbdata.curyef ;
FROM ;
tmpkmyeb ;
LEFT OUTER JOIN zbdata ;
ON Tmpkmyeb.kmh = zbdata.dh ;
WHERE (tmpkmyeb.rq=m.myrq) INTO TABLE tmpyeb
*BROWSE
REPLACE ye00 WITH 0 FOR ISNULL(kmh00)

REPLACE ye WITH ye00 ALL
REPLACE ye WITH VAL(kmh) FOR yef ="C"
*!* gaaaaaaaaaaaaaaaaaaaaaaaaaa

*IF zbdata.yef="0"
REPLACE ye WITH 0 FOR yef="5" AND ( yef00="2" OR (yef00="0" AND ye<0) )
REPLACE ye WITH 0 FOR yef="6" AND (yef00="1" OR (yef00="0" AND ye>0))


IF zbdata.yef="4"
REPLACE ye WITH ABS(ye) FOR yef00="2"
REPLACE ye WITH ABS(ye) FOR yef="6"
*!* REPLACE ye WITH ABS(ye) FOR yef="6" AND (yef00="0" AND ye<0)
*!* REPLACE ye WITH ABS(ye) FOR yef="2"
ENDIF

*endif




**REPLACE opertor WITH "+" FOR opertor="-" AND zbdata.yef="4"
***************************************



***************************
*browse
DIMENSION m.myarr[1]
m.myarr[1]=0
mysumstr=""

SCAN
m.myarr[1]=0
DO CASE
CASE yef="7"
SELECT SUM(je3) FROM kb00 WHERE rq>=CTOD(STR(YEAR(m.myrq),4)+"/01/01") AND rq<=m.myrq AND kmh=(tmpyeb.kmh) INTO ARRAY myarr
REPLACE ye WITH m.myarr[1]
CASE yef="8"
SELECT SUM(je4) FROM kb00 WHERE rq>=CTOD(STR(YEAR(m.myrq),4)+"/01/01") AND rq<=m.myrq AND kmh=(tmpyeb.kmh) INTO ARRAY myarr
REPLACE ye WITH m.myarr[1]*-1
ENDCASE
IF tmpyeb.opertor="("
mysumstr=mysumstr+tmpyeb.opertor
ELSE
mysumstr=mysumstr+STR(tmpyeb.ye,18,2)+tmpyeb.opertor
ENDIF

ENDSCAN
mysumstr=SUBSTR(mysumstr,1,LEN(mysumstr)-1)
mysumstr=STRTRAN(mysumstr,SPACE(1),"")
mysumstr=STRTRAN(mysumstr,")0.00",")")

**? mysumstr
*WAIT WINDOWS STR(EVALUATE(mysumstr),16,2) NOWAIT
mysumstr="myvalue="+mysumstr
*STRTOFILE(mysumstr,"c:\sht.txt")




*********************************
SELECT SELECT(myworkarea)
IF THISFORM.iszero(m.mysumstr)
myvalue=0
ELSE
&mysumstr
ENDIF
RETURN myvalue
hb_123456 2005-10-26
  • 打赏
  • 举报
回复
对不起,经测试EVAL表达式可超过255字符,但(路口就在不远处)所提供思路未解决“()”运算符问题。且除0判断过于简单,是否可通过 on error 来处理,但本人写简短代码结果不理想。实际上真正会计科目有借方科目,贷方科目,双向科目,为迁就公式,这其中往往不是借方用正数,贷方用负数能解决!真正会计报表生成,有关业务指标自成生成,敬请各位继续赐教!
十豆三 2005-10-24
  • 打赏
  • 举报
回复
zsjiaming(路口就在不远处) 如果还有回复请继续。。。
hb_123456 2005-10-23
  • 打赏
  • 举报
回复
上楼回复只是解决部分问题,其实如何将科目号所代表的余额代入内存变量,千万不告诉逐个去取,因为有时公式所涉及科目有时有千个,这其中还有常量(用C标识),并且其中有(+-*/,且需判断eval是否除0错误!上楼所述公式间代表科目号之间并无分隔符号,因公式是上面统一下发,并且经常更新。除了解决问题,注意效率!
zsjiaming 2005-10-23
  • 打赏
  • 举报
回复
xxcaltxt=Strtran(xxcaltxt,'+','+'+Chr(13)) &&加上分隔符
xxcaltxt=Strtran(xxcaltxt,'-','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'*','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'/','+'+Chr(13))

--->修改

xxcaltxt=Strtran(xxcaltxt,'+','+'+Chr(13)) &&加上分隔符
xxcaltxt=Strtran(xxcaltxt,'-','-'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'*','*'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'/','/'+Chr(13))
zsjiaming 2005-10-23
  • 打赏
  • 举报
回复
replace your_dbf_name.mycal WITH newcalc

xxcaltxt=your_dbf_name.newcalc
..............>修改成 xxcaltxt=your_dbf_name.mycal
zsjiaming 2005-10-23
  • 打赏
  • 举报
回复
*如果公式是已经有了.那么假设保存在your_dbf_name表中的calmemo字段
*解决方法是表your_dbf_name设多二个备注字段
* calmemo字段,存放原始表达式
* mycal字段 ,存放处理后的计算表达式 (分成250一段段代码)
* mydiv字段 ,存放所有除数
*注意保存calmemo原始表达式时

*当calmemo更新变化时,请执行下面代码
FUNCTION new_calc
LPARAMETERS txt_calc
Local xxcaltxt,mycaltxt,caltxt,mydivtxt,divtxt,ckmtemp,cvartemp
Local aakm(1)

IF NOT USED(your_dbf_name) &&根据实际修改,保证your_dbf_name是打开的
USE your_dbf_name IN 0
ENDIF
replace your_dbf_name.mycal WITH newcalc

xxcaltxt=your_dbf_name.newcalc
xxcaltxt=Strtran(xxcaltxt,'+','+'+Chr(13)) &&加上分隔符
xxcaltxt=Strtran(xxcaltxt,'-','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'*','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'/','+'+Chr(13))
Use km_dbf_name In 0
Select km_dbf_name
Set Order To kemu &&科目编号为序
*km_dbf_name 为一个表,二个字段......
*字段kemu 为科目代码如11110,或常数名..
*km_calc为实际计算时用到的字段名,或变量名,或常数的值..
lnvarnum=Aline(acal,xxcaltxt) &&解析表达式
mycaltxt=""
mydivtxt=""
caltxt=""
divtxt=""
For i=1 To lnvarnum
calsign=Iif(Left(acal(i),1)$'+-*/',Left(acal(i),1),"") &&运算符
ckmtemp=Iif(Empty(calsign),acal(i),Substr(acal(i),2)) &&科目名
ckmtemp=Padr(Alltrim(ckmtemp),km_field_len) &&为了与字段一样长,km_field_len换成实际字段长
Seek (ckmtemp)
If Found()
cvartemp=km_dbf_name.km_calc
Else
Use In km_dbf_name
Messagebox("没找到科目"+ckmtemp)
Return .F.
Endif

If Len(caltxt)+Len(cvartemp)>250 &&
mycaltxt=mycaltxt+caltxt+Chr(13) &&用回车分为一段段
caltxt="" &&清空
Endif
caltxt=caltxt+calsign+cvartemp
If calsign=='/'
mydivtxt=mydivtxt+cvartemp+Chr(13)
Endif
Endfor
Use In km_dbf_name
mycaltxt=mycaltxt+caltxt+Chr(13)
Replace your_dbf_name.mycal With mycaltxt,your_dbf_name.mydiv With mydivtxt
RETURN .t.


*运算
FUNCTION now_calc
Local acal(1),lnvarnum,caltemp,caltxt,lnresult,xxcaltxt
xxcaltxt=your_dbf_name.mycal
xxdivtxt=your_dbf_name.mydiv

lnvarnum=Aline(acal,xxdivtxt) &&取所有除数
FOR i=1 TO lnvarnum
caltemp=acal(i)
IF &caltemp==0
MESSAGEBOX("除数为0,不能运算")
RETURN 0
ENDIF
ENDFOR

lnvarnum=Aline(acal,xxcaltxt) &&取所有除数
caltemp=""
For i=1 To lnvarnum
lnresult=Evaluate("caltemp"+acal(i)) &&分段计算表达式..中间结果
caltemp=lnresult
Endfor
RETURN lnresult

**VFP运算的速度不会慢,只是文件.字段读取会影响速度
**所以主要是表达式解析时慢一点,但一旦生成保存后,运算时不会慢.
zsjiaming 2005-10-22
  • 打赏
  • 举报
回复
============VFP 9.0
如果表达式超过255个字符.那么保存它的就应该是个备注字段才行,这了方便运算
它保存的格式应该是:(也就是运算符与变量连在一起,并用','分开)
运算符号变量名,运算符号变量名,.............保存在备注字段中
要运算的时候:

xxcaltxt=your_dbf_name.calmemo &&取得备注内容
local acal(1),lnvarnum,caltemp,caltxt,lnresult
lnvarnum=aline(acal,xxcaltxt,2,',')
caltxt=""
for i=1 to lnvarnum
if len(caltxt)+len(acal(i))>250
lnresult=evaluate(caltxt) &&计算已有表达式..中间结果
caltemp=lnresult
caltxt="caltemp" &&把计算的结果做为第一个数
endif
caltxt=caltxt+acal(i)
endfor
lnresult=evaluate(caltxt) &&计算最后结果

=========VFP 6.0
如果表达式超过255个字符.那么保存它的就应该是个备注字段才行,这了方便运算
它保存的格式应该是:(也就是运算符与变量连在一起,并用CHR(13)分开)
运算符号变量名+CHR(13)+运算符号变量名+CHR(13)........保存在备注字段中
要运算的时候:

xxcaltxt=your_dbf_name.calmemo &&取得备注内容
local acal(1),lnvarnum,caltemp,caltxt,lnresult
lnvarnum=aline(acal,xxcaltxt) &&VFP6.0不能指定分隔号
caltxt=""
for i=1 to lnvarnum
if len(caltxt)+len(acal(i))>250
lnresult=evaluate(caltxt) &&计算已有表达式..中间结果
caltemp=lnresult
caltxt="caltemp" &&把计算的结果做为第一个数
endif
caltxt=caltxt+acal(i)
endfor
lnresult=evaluate(caltxt) &&计算最后结果





hb_123456 2005-10-20
  • 打赏
  • 举报
回复
用evaluate 或宏替换其表达式不能超过255个字符,超过255个字符如何求值?
zsjiaming 2005-10-19
  • 打赏
  • 举报
回复
*用组合框B(选择科目名称).组合框A(+-*/)
思路之一:
组合框A 组合框B
组合框A 组合框B
组合框A 组合框B
....
操作保存..可以生成公式. 把公式做为一个串保存在表中 计算时用evaluate 或宏替换
xx=evaluate(txtcal)
或 lctxtcal='xx='+txtcal
&lctxtcal

2,748

社区成员

发帖
与我相关
我的任务
社区描述
VFP,是Microsoft公司推出的数据库开发软件,用它来开发数据库,既简单又方便。
社区管理员
  • VFP社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧