如何实现一下按条件分工作薄 - 编程论坛

#2

吹水佬2022-01-03 20:56

作战地图看不明，给个战果图看看
或者将主表先导出到DBF处理好后再放到EXCEL模板

#3

ls_y0412022-01-03 21:04

表达不清晰呀，哈哈。难为大家了。上面的表是导出来的表，想通过程序按工单号生成模板文件。转换到下面的模板文件中对应颜色的字段，按编号对数量进行汇总

#4

wcx_cc2022-01-03 22:04

这个实现的话不是难事吧.按吹佬所说,先将主表原样变成一个 dbf表(可采用导入法放入1个 dbf ),将这个dbf用 select * from 方法,按照想要的条件
生成汇总表(dbf),如果一步达不到可以多做一步,这个汇总表的结构要等同于那个汇总模板.最后将dbf汇总表生成电子表格.

#5

ls_y0412022-01-04 02:40

LOCAL fsheet,fname,oExcel,fname1
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)
sys(3099,70)
SET SAFETY OFF

xlsFile = cDefPath + "维修发料统计.xls"
WITH CREATEOBJECT("Excel.Application")
    .DisplayAlerts = 0
    .WorkBooks.Open(xlsFile)
    nRow = .CountA(.Range("A:A")) - 2
    nCol = .CountA(.Range("4:4"))
    arr  = .Cells(5,1).Resize(nRow,nCol).Value
    .WorkBooks.Close
    .Quit
ENDWITH

CREATE CURSOR tt (序号 I,经销商简称 C(10),工单号 c(12),零部件代码 C(18),零部件名称 C(30),仓库代码 C(10),库位代码 C(12),零部件数量 N(6,2),销售单价 N(6,2),;
零部件销售金额 N(6,2),零部件成本金额 N(6,2),车牌号 C(10),车系 C(10),领料人 C(10),维修类型 C(10))
INSERT INTO tt FROM ARRAY arr

SELECT * FROM tt INTO cursor 细 READWRITE

SELECT 细
REPLACE 仓库代码 WITH Iif("TW-" $ 零部件代码, '配件仓库B', '配件仓库A') ALL
REPLACE 工单号 WITH righ(工单号,10) all

SELECT  序号 ,工单号,零部件代码,零部件名称,销售单价,SUM(零部件数量) as  数量,领料人,仓库代码,车牌号,维修类型 ;
FROM 细  GROUP BY 零部件代码 INTO cursor 明细1
BROWSE

select * from 明细1 where 数量 > 0 INTO cursor 明细

brow

SET DEFAULT TO d:\xls

lc_filename=cDefPath+'模版.xls'
IF !FILE(lc_filename)
    MESSAGEBOX('不存在模版文件')
    RETURN
ENDIF

SELECT DISTINCT 工单号 FROM 明细 INTO CURSOR RKD
    eole=createobject("excel.application")

    eole.workbooks.open(lc_filename,.F.,.F.)
m=20
SELECT RKD
SCAN
    FOR q=2 TO m&&保证清空前面工单的记录
        eole.cells(q,1).value=''
        eole.cells(q,2).value=''
        eole.cells(q,3).value=''
        eole.cells(q,4).value=''
        eole.cells(q,5).value=''
        eole.cells(q,6).value=''
        eole.cells(q,7).value=''
        eole.cells(q,8).value=''
        eole.cells(q,9).value=''
        eole.cells(q,10).value=''
        eole.cells(q,11).value=''
        eole.cells(q,12).value=''
        eole.cells(q,13).value=''
        eole.cells(q,14).value=''
    ENDFOR
    SELECT 序号 as 行,车牌号 as T,零部件代码 AS 项目,零部件名称 as 说明,序号 AS 套餐,序号 AS W,数量,;
    销售单价 as 含税单价,领料人 as 折扣,序号 as 总计,维修类型  as V,序号 as P,工单号 AS I,仓库代码 as 仓库名称 ;
    FROM 明细 ;
   WHERE 工单号=RKD.工单号 ORDER BY I ;
   INTO CURSOR TEMP
    z='d:\xls\'+ALLTRIM(temp.I)+ALLTRIM(temp.T)+(temp.V)+ALLTRIM(temp.折扣)+'.xls'
    IF FILE(z)
        DELETE FILE (z)
    ENDIF

**    copy to (z)  type xl5
    SELECT temp
    m=1
    SCAN
        m=m+1
        eole.cells(m,1).value=行
        eole.cells(m,2).value=T
        eole.cells(m,3).value=项目
        eole.cells(m,4).value=说明
        eole.cells(m,5).value=套餐
        eole.cells(m,6).value=W
        eole.cells(m,7).value=数量
        eole.cells(m,8).value=含税单价
        eole.cells(m,9).value=折扣
        eole.cells(m,10).value=总计
        eole.cells(m,11).value=V
        eole.cells(m,12).value=P
        eole.cells(m,13).value=I
        eole.cells(m,14).value=仓库名称
    ENDSCAN
    eole.ActiveWorkbook.Saved=.t.
    eole.ActiveWorkbook.SaveAs(z)

    SELECT RKD
ENDSCAN
    eole.quit
    RELEASE eole

MESSAGEBOX('处理完成）
以上代码是拼的实现的有点乱，不能处理按编码对数量进行汇总

[此贴子已经被作者于2022-1-4 02:51编辑过]

#6

laowan0012022-01-04 08:32

把主表导入dbf，按要求加工成最终结果，然后按工单号导出EXCEL
“按编号对数量汇总”，这个编号不知道是工单号还是代码
VFP对数据处理是强项，对表格加工不方便，建议先加工成需要的数据，然后导出表格

#7

ls_y0412022-01-04 10:08

是说以工单号进行分工作薄，每个工作薄中再按编号进行对数量的汇总，大于0的要，否则就不要了。谢谢

#8

laowan0012022-01-04 11:59

outfile = sys(2015)
SELECT 工单号,维修类型,领料人,代码项目,零部件名称说明,SUM(零部件数量) 数量,销售单价含税单价,仓库代码仓库名称 FROM 总表 GROUP BY 工单号,维修类型,领料人,代码,零部件名称,销售单价,仓库代码 HAVING SUM(零部件数量)>0 INTO CURSOR outfile READWRITE

之后对outfile按：工单号+维修类型+领料人分别导出EXCEL表

#9

ls_y0412022-01-04 13:12

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

#10

wengjl2022-01-04 13:41

这个功能在EXCEL中的宏（VBA）就能实现。只是看楼主的描述...

用VFP解决
1、主表要转为DBF表AA
2、生成单号库的DBF表BB
3、做好一个模板表对应的DBF表CC
4、依BB循环，依次从AA提取数据到CC，再CC转为EXCEL 就成功了

#11

ls_y0412022-01-04 17:11

能不能写一下代码，别人写的代码我也是乱了不知道如何调整一下，谢谢。

#12

ls_y0412022-01-04 17:18

           在实际工作中，有时候需要根据设定的列表对一个工作表中的数据进行拆分，或者拆分为多个工作表，或者拆分为多个工作簿文件，本工具特为这个需求而写，Sub 拆分之四()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim d As Object
Dim ar As Variant, br As Variant
Dim arr()
Set d = CreateObject("scripting.dictionary")
w = InputBox("请输入数据源表中列标题行数", , "1")
If w = "" Then MsgBox "您没有输入数据源表中列标题行数": Exit Sub
x = InputBox("请输入数据源表中拆分依据列的列号", , "8")
If x = "" Then MsgBox "您没有输入数据源表中拆分依据列的列号": Exit Sub
p = MsgBox("拆分为工作表请选择是，拆分为工作簿请选择否", vbYesNoCancel)
If p = vbCancel Then Exit Sub
If p = vbYes Then
    For Each sh In Sheets
        If sh.Name <> "数据源" And sh.Name <> "拆分列表" Then
            sh.Delete
        End If
    Next sh
End If
ar = Sheets("拆分列表").[a1].CurrentRegion
With Sheets("数据源")
    r = .Cells(Rows.Count, 8).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    br = .Range(.Cells(1, 1), .Cells(r, y))
End With
Set Rng = ThisWorkbook.Worksheets("数据源").Rows(1)
For j = 1 To UBound(ar, 2)
    If Trim(br(1, j)) <> "" Then
        n = 0
        ReDim arr(1 To UBound(br), 1 To UBound(br, 2))
        d.RemoveAll
        For i = 2 To UBound(ar)
            If Trim(ar(i, j)) <> "" Then
                d(Trim(ar(i, j))) = ""
            End If
        Next i
        For i = Val(w) + 1 To UBound(br)
            If Trim(br(i, Val(x))) <> "" Then
                mc = Trim(br(i, Val(x)))
                If d.Exists(Trim(mc)) Then
                    n = n + 1
                    For jj = 1 To UBound(br, 2)
                        arr(n, jj) = br(i, jj)
                    Next jj
                End If
            End If
        Next i
        If n <> 0 Then
            If p = vbYes Then
                Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
                With sht
                    .Name = ar(1, j)
                    .[a1].CurrentRegion = Empty
                    Rng.Copy .[a1]
                    .Cells(w + 1, 1).Resize(n, UBound(arr, 2)) = arr
                End With
            ElseIf p = vbNo Then
                Set wb = Workbooks.Add
                With wb.Worksheets(1)
                    .Name = ar(1, j)
                    Rng.Copy .[a1]
                    .Cells(w + 1, 1).Resize(n, UBound(arr, 2)) = arr
                End With
                wb.SaveAs Filename:=ThisWorkbook.Path & "\" & ar(1, j)
                wb.Close
            End If
        End If
    End If
Next j
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

#13

独木星空2022-01-04 17:19

回复 5楼 ls_y041

学习学习在说。还是有点蒙。

#14

ls_y0412022-01-04 17:49

有代码也不行看不明白

#15

ls_y0412022-01-04 20:12

Sub 拆分()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br(), brr()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("数据集合")
    rs = .Cells(Rows.Count, 26).End(xlUp).Row
    If rs < 3 Then MsgBox "数据集合为空！": End
    ar = .Range("a1:z" & rs)
End With
For Each sh In Sheets
    dc(sh.Name) = ""
Next sh
For i = 3 To UBound(ar)
    If Trim(ar(i, 26)) <> "" Then
        d(Trim(ar(i, 26))) = ""
    End If
Next i
For Each k In d.keys
    n = 0
    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    For i = 3 To UBound(ar)
        If Trim(ar(i, 26)) = k Then
            n = n + 1
            For j = 2 To UBound(ar, 2)
                br(n, j - 1) = ar(i, j)
            Next j
        End If
    Next i
    If dc.exists(k) Then
        With Sheets(k)
            r = .Cells(Rows.Count, 25).End(xlUp).Row
            .Range("a3:ab" & r) = Empty
            .[a3].Resize(n, UBound(br, 2)) = br
        End With
    End If
Next k
Application.ScreenUpdating = True
MsgBox "数据拆分完毕!", 64, "提示"
End Sub

#16

ls_y0412022-01-04 20:49

期待吹版主吧

#17

吹水佬2022-01-04 22:40

一开始不就是两表吗？无需贴些不相关的代码。
一个表有数据的，另一个表无数据的。
只见几条箭头路线，看不明白结果是什么。
你就手动算算，将要的结果填到空表里给人看看就好了。人家看不懂会问你，这样交流够直接，不用绕圈子。

#18

ls_y0412022-01-05 08:45

回复楼主 ls_y041

我重新调整了一下问题，请版主帮助处理一下，

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

#19

ls_y0412022-01-05 08:47

回复 17楼吹水佬

主表中的兰色的字段只是为了保存工作表的名称，不用写到下面表中，实际用到的数据只是黄色的部分。我重新上传了附件，请帮助一下

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

[此贴子已经被作者于2022-1-5 08:50编辑过]

#20

laowan0012022-01-05 09:42

* 先把总表.xlsx导入到总表.dbf
local outfile,xoutlist,xfile,xfilename
outfile = sys(2015)
SELECT 工单号,维修类型,领料人,代码项目,零部件名称说明,SUM(零部件数量) 数量,销售单价含税单价,仓库代码仓库名称 FROM 总表 GROUP BY 工单号,维修类型,领料人,代码,零部件名称,销售单价,仓库代码 HAVING SUM(零部件数量)>0 INTO CURSOR outfile READWRITE

xoutlist = sys(2015)
select distinct 工单号,维修类型,领料人 from &outfile into cursor &xoutlist readwrite
select &xoutlist
scan    && 导出每一个工作表
    xfile = sys(2015)
    select * from &outfile where 工单号=&xoutlist..工单号 and 维修类型=&xoutlist..维修类型 and 领料人=&xoutlist..领料人 ;
        into cursor &xfile readwrite    && 查询一个工作表的数据，根据需要保留或添加必要的字段
    xfilename = alltrim(工单号)+alltrim(维修类型)+alltrim(领料人)
    select &xfile
    copy to &xfilename type xl5
    use in &xfile
    select &xoutlist
end
use in &xoutlist

[此贴子已经被作者于2022-1-5 09:45编辑过]

#21

ls_y0412022-01-05 11:07

这个copy to &xfilename type xl5复制出来的文件只能是2003以上的版本才可以的，谢谢！！

#22

ls_y0412022-01-05 11:28

回复 20楼 laowan001

我上传主表，请帮助调试一下，

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

#23

laowan0012022-01-05 11:57

以下是引用ls_y041在2022-1-5 11:07:45的发言：

这个copy to &xfilename type xl5复制出来的文件只能是2003以上的版本才可以的，谢谢！！

这话的意思是导出的文件不满足要求吗？没看懂
你截图里除了总表是xlsx，其他都是xls，用上面的命令导出就是xls格式的

[此贴子已经被作者于2022-1-5 11:58编辑过]

#24

ls_y0412022-01-05 13:52

是说要用模板的表另存为工作薄上面的代码运行后会提示打开表

#25

laowan0012022-01-05 14:26

以下是引用ls_y041在2022-1-5 13:52:13的发言：

是说要用模板的表另存为工作薄上面的代码运行后会提示打开表

没明白什么意思。
如果必须要在VFP里用模板的话，我就不灵了

#26

laowan0012022-01-05 14:29

你的总表转成dbf了吗？

#27

ls_y0412022-01-05 14:31

我的表在22楼

#28

laowan0012022-01-05 14:41

程序代码：

CLOSE DATABASES

local outfile,xoutlist,xfile,xfilename
outfile = sys(2015)
SELECT 工单号,维修类型,领料人,代码项目,零部件名称说明,SUM(零部件数量) 数量,销售单价含税单价,仓库代码仓库名称 ;
    FROM 主表 GROUP BY 工单号,维修类型,领料人,代码,零部件名称,销售单价,仓库代码 HAVING SUM(零部件数量)>0 INTO CURSOR &outfile READWRITE

xoutlist = sys(2015)
select distinct 工单号,维修类型,领料人 from &outfile into cursor &xoutlist readwrite
select &xoutlist
scan    && 导出每一个工作表
    xfile = sys(2015)
    select * from &outfile where 工单号=&xoutlist..工单号 and 维修类型=&xoutlist..维修类型 and 领料人=&xoutlist..领料人 ;
        into cursor &xfile readwrite    && 查询一个工作表的数据，根据需要保留或添加必要的字段
    xfilename = alltrim(工单号)+alltrim(维修类型)+alltrim(领料人)
    select &xfile
    copy to &xfilename type xl5
    use in &xfile
    select &xoutlist
ends
use in &xoutlist

程序修改了，试下吧
一共生成了6个xls

#29

laowan0012022-01-05 14:48

程序代码：

CLOSE DATABASES

local outfile,xoutlist,xfile,xfilename
outfile = sys(2015)
SELECT 工单号,维修类型,领料人,代码项目,零部件名称说明,SUM(零部件数量) 数量,销售单价含税单价,仓库代码仓库名称 ;
    FROM 主表 GROUP BY 工单号,维修类型,领料人,代码,零部件名称,销售单价,仓库代码 HAVING SUM(零部件数量)>0 INTO CURSOR &outfile READWRITE

xoutlist = sys(2015)
select distinct 工单号,维修类型,领料人 from &outfile into cursor &xoutlist readwrite
select &xoutlist
scan    && 导出每一个工作表
    xfilename = alltrim(工单号)+alltrim(维修类型)+alltrim(领料人)
    xfile = sys(2015)
    select SPACE(2) 行,SPACE(2) T,项目,说明,SPACE(2) 套餐,SPACE(2) W,数量,含税单价,SPACE(2) 折扣,SPACE(2) 总计,SPACE(2) V,SPACE(2) P,SPACE(2) I,仓库名称 ;
        from &outfile where 工单号=&xoutlist..工单号 and 维修类型=&xoutlist..维修类型 and 领料人=&xoutlist..领料人 ;
        into cursor &xfile readwrite    && 查询一个工作表的数据，根据需要保留或添加必要的字段
    select &xfile
    copy to &xfilename type xl5
    use in &xfile
    select &xoutlist
ends
use in &xoutlist

这是导出你模板那样子的

#30

ls_y0412022-01-05 15:39

这个表不是2003的版本，不行不可以导入到其他的软件中。

#31

laowan0012022-01-05 17:05

以下是引用ls_y041在2022-1-5 15:39:05的发言：

这个表不是2003的版本，不行不可以导入到其他的软件中。

2003版本是啥样子的？
“不行不可以导入到其他的软件中”是啥意思？

#32

ls_y0412022-01-05 18:20

是这样的事，我做这样的工作表是为了把这个总表的数据导入到其他的软件中去，人家给的模板文件是2003及以上的，不能导入低于2003版本的。
就是说不能动人家的模板文件。

#33

laowan0012022-01-05 20:12

VFP的copy to ... xl5就是扩展名xls的，你给的模板也是xls扩展名，也可以另存为你要的版本

#34

ls_y0412022-01-06 11:39

主要是应用在其他软件的导入工作中就是不认这个文件，才让人头疼呀

#35

wengjl2022-01-06 13:13

你的模板是什么版本呢？

#36

ls_y0412022-01-06 13:27

软件是xlsx,最低的版本为2003

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

#37

zhaihs772022-01-18 13:35

学习一下

#38

wengjl2022-01-24 15:40

以下是引用ls_y041在2022-1-6 11:39:39的发言：

主要是应用在其他软件的导入工作中就是不认这个文件，才让人头疼呀

不一定是版本的问题。

有可能是你的表字段名的问题，也会导致无法导入的现象产生

#39

ls_y0412022-01-24 15:43

因为另存为XLS就可以了