注册 登录
编程论坛 VFP论坛

再次求助:如何根据“开支明细”动态生成“开支统计表.dbf”

王咸美 发布于 2025-10-29 12:38, 421 次点击
现有“开支明细表.dbf",我想根据其中的“支出明细”动态生成“开支统计表.dbf",开支统计表中的字段名由“开支明细表.dbf的“开支明细”动态生成,请各位高手不吝赐教,万分感谢!(纯属个人爱好,不喜勿喷,全当路过)
只有本站会员才能查看附件,请 登录

只有本站会员才能查看附件,请 登录

“开支统计表.dbf"样式如下:
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2025-10-29 12:41编辑过]

27 回复
#2
吹水佬2025-10-29 16:15
老师又出考题
这题是没有“,”也没有“,”了
其实将“元”替换为“,”就与上一题差不多了。
下一题是不是也没有“元”了?
哪来的数据这么另类

#3
yiyanxiyin2025-10-29 16:34
要是品名有个"状元糕"什么的.....
#4
my23182025-10-29 17:11
最后受字段个数限制,这种数据表设计的不好
#5
王咸美2025-10-29 17:26
谢谢,说的有道理。
#6
王咸美2025-10-29 21:50
如果“开支明细”中内容变为“巧克力9果汁6果冻6.5车费20”,去掉标志“元”,代码应如何写,请高手赐教,谢谢!!!

[此贴子已经被作者于2025-10-29 21:51编辑过]

#7
吹水佬2025-10-29 22:27
以下是引用王咸美在2025-10-29 21:50:10的发言:

如果“开支明细”中内容变为“巧克力9果汁6果冻6.5车费20”,去掉标志“元”,代码应如何写,请高手赐教,谢谢!!!

程序代码:

DECLARE long sscanf IN msvcrt long,string,single@,long@
DECLARE long strcpy IN msvcrt string@,string
DECLARE long strcpy IN msvcrt as strcpy_ptr long,string

cBuffer = REPLICATE(0h00,256)
pBuffer = strcpy(@cBuffer, "")
getExpenditureRecord("巧克力9果汁6果冻6.5车费20")

FUNCTION getExpenditureRecord(er)
    LOCAL a as Single, n as Long, p as Long, ph as Long
    a = 0.00
    n = 0
    p = strcpy_ptr(pBuffer, er)
    ph = p
    DO WHILE SYS(2600,p,1) != 0h00
        IF sscanf(p,"%f%n",@a,@n) == 1
           ? SYS(2600,ph,p-ph), a
           p  = p+n
           ph = p
        ELSE
            p = p+1
        ENDIF
    ENDDO
ENDFUNC



[此贴子已经被作者于2025-10-29 22:33编辑过]

#8
王咸美2025-10-29 22:59
谢谢!如何在代码中加上表文件“开支明细表.dbf"? 盼指点!
#9
吹水佬2025-10-29 23:09
以下是引用王咸美在2025-10-29 22:59:18的发言:

谢谢!如何在代码中加上表文件“开支明细表.dbf"? 盼指点!

getExpenditureRecord(er)可以取出任何一条记录的费用名称和费用金额


#10
王咸美2025-10-30 07:24
谢谢!我想用上表文件“开支明细表.dbf",动态生成如附件所示的“开支统计表.dbf",不知如何操作,请指点!
#11
吹水佬2025-10-30 07:40
以下是引用王咸美在2025-10-30 07:24:19的发言:

谢谢!我想用上表文件“开支明细表.dbf",动态生成如附件所示的“开支统计表.dbf",不知如何操作,请指点!

每条记录的各项费用项目名称和金额都能得到了,还有什么问题?
重温一下之前的贴不就是同一个问题吗?
总结一下之前类同的贴就OK

#12
wengjl2025-10-30 08:11
以下是引用王咸美在2025-10-29 12:38:53的发言:

现有“开支明细表.dbf",我想根据其中的“支出明细”动态生成“开支统计表.dbf",开支统计表中的字段名由“开支明细表.dbf的“开支明细”动态生成,请各位高手不吝赐教,万分感谢!(纯属个人爱好,不喜勿喷,全当路过)


“开支统计表.dbf"样式如下:


从你再次发贴看,你是没看懂为你特开(想着你我是同行,且我退休6年了,地域又远,代码都给你了(作了详细的注释),感觉你的问题是根基不牢)的一贴!

第一步,从“开支明细表”到 kzmx ,中间的ls 就是你现在的无“,,”号的表,是凭“元”字作的区分标志。后面的代码中,均完成了你再次提问的内容,仔细地学研就会得到你想要的。
#13
yiyanxiyin2025-10-30 10:03
数据处理科学过程: 1.数据采集-->2.清洗--->3.转换-->4.分析;    第一步数据采集有了, 就是你采集到的支出明细, 第二步就是上面讨论了的支出明细要用分隔符分开,如果有其他不标准化的数据还需要标准化,有元没元都需要处理,品名中有元或数字的也需要处理, 第三步就是转成便于分析的数据,要能识别品名和价格,第四步就是你的第二个表,就是分析的结果.  每一步都要将结果数据存储起来, 如果有问题便于分析问题出现在那一步
#14
王咸美2025-10-30 12:30
下列程序不知问题出自哪里,现贴上代码,请高手赐教,谢谢!!!
只有本站会员才能查看附件,请 登录

只有本站会员才能查看附件,请 登录

待修改代码如下:
CLOSE DATABASES
CLEAR ALL
PUBLIC  cPath
cPath=ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cPath)

DECLARE long sscanf IN msvcrt long,string,single@,long@
DECLARE long strcpy IN msvcrt string@,string
DECLARE long strcpy IN msvcrt as strcpy_ptr long,string

cBuffer = REPLICATE(0h00,256)
pBuffer = strcpy(@cBuffer, "")


LOCAL a as Single, n as Long, p as Long, ph as Long
a = 0.00
n = 0
CREATE CURSOR tt (姓名 C(10),项目 V(10),金额 N(6,2))
USE 开支明细表.dbf ALIAS tb IN 0
SELECT tb
SCAN
   FOR i=1 TO ALINES(arr,tb.支出明细,5,"")
      p=strcpy_ptr(@pBuffer,arr[i])
      ph=p
      DO WHILE !(SYS(2600,p,1) == 0h00)
        IF sscanf(p,"%f%n",@a,@n) == 1
          INSERT INTO tt  VALUES (tb.姓名,SYS(2600,ph,p-ph), a)
           p  = p+n
           ph = p
           
        ELSE
            p = p+1
        ENDIF
      ENDDO
   ENDFOR
ENDSCAN

cmd="CREATE TABLE 开支统计表 (姓名 C(10)"
SELECT DISTINCT 项目 FROM tt INTO CURSOR tmp
SCAN
  cmd=cmd+","+项目+ " n(6,2)"
ENDSCAN
cmd=cmd + ",合计  n(6,2))"
EXECSCRIPT(cmd)
SELECT distinct 姓名 FROM tt INTO CURSOR tmp
SELECT 开支统计表
APPEND FROM  DBF("tmp")
INDEX on  姓名 TAG  姓名
SELECT tt
SET RELATION TO 姓名 INTO "开支统计表 "
SCAN
  replace (tt.项目)  WITH tt.金额,合计 WITH 合计+tt.金额 IN "开支统计表"
ENDSCAN
SELECT * FROM 开支统计表


#15
吹水佬2025-10-30 14:59
回复 14楼 王咸美
不能照抄
先要理解每行代码在做什么,不明白的地方可以参考自己的学习笔记,或提出问题让大家共同探讨。
之前的 开支明细表 与 现在的 开支明细表 不是简单的有无“,”,不能随便用""改改就是的。
还有要注意一些细节:
SET RELATION TO 姓名 INTO "开支统计表 "
这句的"开支统计表 "应该是"开支统计表"

[此贴子已经被作者于2025-10-30 15:00编辑过]

#16
吹水佬2025-10-30 15:09
要人家给代码,你也要看得明白,还要认真测试一下看看有什么其他的问题,绝对不能照抄。
尤其是我给的代码,甚至连基本的变量声明定义都没有,只能局部问题测试参考,照抄很有可能会出大问题。

#17
吹水佬2025-10-30 15:13
只有本站会员才能查看附件,请 登录

程序代码:

SET DEFAULT TO (ADDBS(JUSTPATH(SYS(16))))
DECLARE long sscanf IN msvcrt long,string,long,single@,long@
DECLARE long strcpy IN msvcrt string@,string
DECLARE long strcpy IN msvcrt as strcpy_ptr long,string
DECLARE long strlen IN msvcrt long
cBuffer = REPLICATE(0h00,256)
pBuffer = strcpy(@cBuffer, "")
cString = REPLICATE(0h00,256)
pString = strcpy(@cString, "")
CREATE CURSOR tt (姓名 C(10),项目 V(10),金额 N(6,2))
USE 开支明细表2 ALIAS tb IN 0
SELECT tb
SCAN
    getExpenditureRecord(ALLTRIM(tb.支出明细))
ENDSCAN
cmd="CREATE TABLE 开支统计表 (姓名 C(10)"
SELECT DISTINCT 项目 FROM tt INTO CURSOR tmp
SCAN
  cmd=cmd+","+项目+ " n(5,2)"
ENDSCAN
cmd=cmd + ",合计  n(6,2))"
EXECSCRIPT(cmd)
SELECT distinct 姓名 FROM tt INTO CURSOR tmp
SELECT 开支统计表
APPEND FROM  DBF("tmp")
INDEX on  姓名 TAG  姓名
SELECT tt
SET RELATION TO 姓名 INTO "开支统计表"
SCAN
  replace (tt.项目) WITH tt.金额, 合计 WITH 合计+tt.金额 IN "开支统计表"
ENDSCAN
SELECT * FROM 开支统计表
CLOSE TABLES ALL
CLEAR ALL
RETURN

FUNCTION getExpenditureRecord(er)
    LOCAL a, n, p
    a = 0.00
    n = 0
    p = pBuffer
    strcpy_ptr(p, er)
    DO WHILE SYS(2600,p,1) != 0h00
        IF sscanf(p,"%[^0-9.]%f%n",pString,@a,@n) == 2
            INSERT INTO tt VALUES (tb.姓名, LEFT(SYS(2600,pString,256),strlen(pString)), a)
            p = p+n
        ELSE
            p = p+1
        ENDIF
    ENDDO
ENDFUNC
#18
吹水佬2025-10-30 15:51
不用API函数可能容易理解点
程序代码:

SET DEFAULT TO (ADDBS(JUSTPATH(SYS(16))))
CREATE CURSOR tt (姓名 C(10),项目 V(10),金额 N(6,2))
USE 开支明细表2 ALIAS tb IN 0
SELECT tb
SCAN
    getExpenditureRecord(ALLTRIM(tb.支出明细))
ENDSCAN
cmd="CREATE TABLE 开支统计表 (姓名 C(10)"
SELECT DISTINCT 项目 FROM tt INTO CURSOR tmp
SCAN
  cmd=cmd+","+项目+ " n(5,2)"
ENDSCAN
cmd=cmd + ",合计  n(6,2))"
EXECSCRIPT(cmd)
SELECT distinct 姓名 FROM tt INTO CURSOR tmp
SELECT 开支统计表
APPEND FROM  DBF("tmp")
INDEX on  姓名 TAG  姓名
SELECT tt
SET RELATION TO 姓名 INTO "开支统计表"
SCAN
  replace (tt.项目) WITH tt.金额, 合计 WITH 合计+tt.金额 IN "开支统计表"
ENDSCAN
SELECT * FROM 开支统计表
CLOSE TABLES ALL
CLEAR ALL
RETURN

FUNCTION getExpenditureRecord(er)
    s = ""
    i = 1
    len = LEN(er)
    DO WHILE i <= len
        ch = SUBSTR(er,i,1)
        IF ISDIGIT(ch) OR ch=="."
            a = VAL(SUBSTR(er,i))
            INSERT INTO tt VALUES (tb.姓名, s, a)
            s = ""
            n = i
            DO WHILE ISDIGIT(ch) OR ch=="."
                n = n+1
                ch = SUBSTR(er,n,1)
            ENDDO
            i = n
        ELSE
            s = s+ch
            i = i+1
        ENDIF
    ENDDO
ENDFUNC


#19
王咸美2025-10-30 16:30
谢谢!!!
#20
sam_jiang2025-10-30 18:57
举一反三,举一反三,举一反三。。。

#21
wengjl6 天前 08:23
以下是引用吹水佬在2025-10-30 15:51:05的发言:不用API函数可能容易理解点SET DEFAULT TO (ADDBS(JUSTPATH(SYS(16))))CREATE CURSOR tt (姓名 C(10),项目 V(10),金额 N(6,2))USE 开支明细表2 ALIAS tb IN 0SELECT tbSCAN    getExpenditureRecord(ALLTRIM(tb.支出明细))ENDSCANcmd="CREATE TABLE 开支统计表 (姓名 C(10)"SELECT DISTINCT 项目 FROM tt INTO CURSOR tmpSCAN  cmd=cmd+","+项目+ " n(5,2)"ENDSCANcmd=cmd + ",合计  n(6,2))"EXECSCRIPT(cmd)SELECT distinct 姓名 FROM tt INTO CURSOR tmpSELECT 开支统计表APPEND FROM  DBF("tmp")INDEX on  姓名 TAG  姓名SELECT ttSET RELATION TO 姓名 INTO "开支统计表"SCAN  replace (tt.项目) WITH tt.金额, 合计 WITH 合计+tt.金额 IN "开支统计表"ENDSCANSELECT * FROM 开支统计表CLOSE TABLES ALL CLEAR ALL RETURNFUNCTION getExpenditureRecord(er)    s = ""    i = 1    len = LEN(er)    DO WHILE i <= len        ch = SUBSTR(er,i,1)        IF ISDIGIT(ch) OR ch=="."            a = VAL(SUBSTR(er,i))            INSERT INTO tt VALUES (tb.姓名, s, a)            s = ""            n = i            DO WHILE ISDIGIT(ch) OR ch=="."                n = n+1                ch = SUBSTR(er,n,1)            ENDDO            i = n        ELSE            s = s+ch            i = i+1        ENDIF    ENDDOENDFUNC


吹版好,您在过程中用了 ISDIGIT(ch) OR ch=="." 判断是否是数字或小数点。 如果要分离的是汉字与字母的混合字符串,那么判断 字母 的函数是什么?麻烦告知一下,谢谢!
#22
吹水佬6 天前 13:55
回复 21楼 wengjl
ISLEADBYTE()
ISALPHA()
ISLOWER()
ISUPPER()
#23
wengjl6 天前 17:07
以下是引用吹水佬在2025-11-2 13:55:21的发言:

ISLEADBYTE()
ISALPHA()
ISLOWER()
ISUPPER()


感谢吹版的热心回复,谢谢!
#24
wengjl4 天前 09:02

学习反馈:

    **************************
    * 名称:从汉字与数字的混合字符串中分离数字
    * 问题来源:https://bbs.bc-cn.net/thread-514561-1-1.html
    * 举一反三:稍微修改一下,可以分离汉字中的英文字母;当字符串中有汉字、字母、数字也可以分离了。
    * 时间:2025-11-3
    **************************
    CLEAR
    SET SAFETY off
    SET engi 70
    CLOSE DATABASES
   
    er=[巧克力12.67果汁11.50果冻6.5车费20.09]
    c_zfc=[]
    n_zfc=[]
    s = ""
    i = 1
    lena = LEN(er)
    DO WHILE i <= lena                              &&& 循环到 i > lena 时结束
        ch = SUBSTR(er,i,1)                         &&& 在er上提取第 i 个字节(汉字为双字节的,半个半个取,合并后还是正常的汉字)
        IF ISDIGIT(ch) OR ch=="."                   &&& ISDIGIT(ch)是判断字符表达式(ch)的最左边一个字符是否为数字(0 到 9)。 如果是数字或小数点
            *a = VAL(SUBSTR(er,i))                  &&& 首部的数字转换为数值型,汉字后的数字会忽略不计
            c_zfc=c_zfc+s+[|]                       &&& 将货品名记录到变量中,以 | 分隔。
            s = ""                                  &&& 变量重启(初始化)
            n=i                                     &&& 转换计数变量是的一个很好思维方式
            DO WHILE ISDIGIT(ch) OR ch=="."         &&& 从遇到数字开始,遇到汉字结束
                n=n+1
                ch = SUBSTR(er,n,1)                 &&& 循环时先取得数字,每次覆盖,数字结束时取的是数字后续的汉字的左半个,理解不了,加“? i”观察运行结果后理解了
            ENDDO
            n_zfc=n_zfc+SUBSTR(er,i,n-i)+[|]        &&& 取出数字的字符串到变量中,以 | 分隔。
            i=n
        ELSE
            s = s+ch                                &&& 记录货品名称(半个双字节合并后,还是正常的汉字)
            i = i+1                                 &&& 计数
        ENDIF
    ENDDO
    ? c_zfc            &&& 观察结果
    ? n_zfc
    * 对字符串“c_zfc 、 n_zfc”的再处理,可解决好多问题!
    RETURN
   
   
*!*        判断字母,以下函数有用(收录于此,需要时对上述代码修正修正就能实现需求)
*!*        ISLEADBYTE()    &&& 如果字符表达式第一个字符的首字节是前导字节,则返回“真”(.T.)。
*!*        ISALPHA()       &&& 判断字符表达式的最左边一个字符是否为字母。   返回逻辑值
*!*        ISLOWER()       &&& 判断字符表达式最左边的字符是否为小写字母。   返回逻辑值
*!*        ISUPPER()       &&& 判断字符表达式的首字符是否为大写字母 (A~Z)。返回逻辑值

#25
yiyanxiyin4 天前 10:12
可以用正则表达式"([\u4e00-\u9fa5]+)(\d+\.?\d*)"提取出品名和价格, 这个最简单易懂, vfp引入vbscript.regexp即支持正则表达式
#26
wengjl4 天前 13:26
以下是引用yiyanxiyin在2025-11-4 10:12:57的发言:

可以用正则表达式"([\u4e00-\u9fa5]+)(\d+\.?\d*)"提取出品名和价格, 这个最简单易懂, vfp引入vbscript.regexp即支持正则表达式


我不识英文,但很好学,所以但凡学来的,都会注释上中文,便于需要时易读懂和引用。麻烦给一段VFP代码呗,谢谢您啦!
#27
yiyanxiyin4 天前 14:30
以下deepseek生成的vba代码在wps的excel中测试没问题:
程序代码:
Sub ExtractItemsAndPrices()
    Dim inputString As String
    Dim regex As Object
    Dim matches As Object
    Dim match As Object
    Dim i As Integer
   
    ' 原始字符串
    inputString = "巧克力12.67果汁11.50果冻6.5车费20.09"
   
   
' 创建正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
   
    ' 设置正则表达式模式
   
' 匹配:一个或多个中文字符 + 一个或多个数字(可能包含小数点)
    regex.Pattern = "([\u4e00-\u9fa5]+)(\d+\.?\d*)"
    regex.Global = True
    regex.IgnoreCase = True
   
    ' 执行匹配
    Set matches = regex.Execute(inputString)
   
   
' 清除可能存在的旧数据
    Cells.Clear
   
    ' 设置表头
    Range("A1").Value = "品名"
    Range("B1").Value = "价格"
   
   
' 遍历所有匹配项并输出到工作表
    i = 2
    For Each match In matches
        If match.SubMatches.Count >= 2 Then
            Cells(i, 1).Value = match.SubMatches(0)  ' 品名
            Cells(i, 2).Value = CDbl(match.SubMatches(1))  
' 价格(转换为数字)
            i = i + 1
        End If
    Next match
   
    ' 自动调整列宽
    Columns("A:B").AutoFit
   
   
' 显示结果
    MsgBox "成功提取出 " & (i - 2) & " 个商品信息!", vbInformation
End Sub

下面是vfp的代码, 请参考(没有vfp环境, 没测试):
程序代码:
* 使用VBScript.RegExp对象
CLEAR
LOCAL lcString, loRegEx, loMatches, loMatch, i

lcString = "巧克力12.67果汁11.50果冻6.5车费20.09"

TRY
    * 创建正则表达式对象
    loRegEx = CREATEOBJECT("VBScript.RegExp")
    loRegEx.Pattern = "([\u4e00-\u9fa5]+)(\d+\.?\d*)"
    loRegEx.Global = .T.
    loRegEx.IgnoreCase = .T.
   
    loMatches = loRegEx.Execute(lcString)
   
    CREATE CURSOR temp_result (品名 C(20), 价格 N(10,2))
   
    FOR i = 0 TO loMatches.Count - 1
        loMatch = loMatches.Item(i)
        IF loMatch.SubMatches.Count >= 2
            lcName = loMatch.SubMatches(0)
            lnPrice = VAL(loMatch.SubMatches(1))
            INSERT INTO temp_result VALUES (lcName, lnPrice)
        ENDIF
    ENDFOR
   
    BROWSE TITLE "使用正则表达式提取结果"
CATCH
    MESSAGEBOX("正则表达式组件不可用", 16, "错误")
ENDTRY
#28
wengjl4 天前 15:02
测试结果正确!
谢谢,谢谢您!
1