如何从“销售明细表.xls”生成“销售统计表.doc”

谢谢指点！原来都是dbf表文件，现在原始表为excel文件，结果表为word文件。，

Sub 销售统计()
    ' 问题来源：https://bbs.bc-cn.net/thread-514582-1-1.html
    '
    ' 时间:2025-11-17
    Sheet2.Select
    Cells.Select
    Selection.ClearContents
    Sheet2.Cells(1, 1).Value = "产品"
    x1 = 2
    Do While Not (IsEmpty(Sheet1.Cells(x1, 3).Value))
      c_qy = Sheet1.Cells(x1, 3).Value
      y2 = 1
      Do While Not (IsEmpty(Sheet2.Cells(1, y2).Value))
        If Sheet2.Cells(1, y2).Value = c_qy Then
          GoTo kk
        End If
        y2 = y2 + 1
      Loop
      Sheet2.Cells(1, y2).Value = c_qy
kk:   x1 = x1 + 1
    Loop
    '******
    x1 = 2
    Do While Not (IsEmpty(Sheet1.Cells(x1, 3).Value))
      c_pm = Sheet1.Cells(x1, 2).Value
      x2 = 2
      Do While Not (IsEmpty(Sheet2.Cells(x2, 1).Value))
        If Sheet2.Cells(x2, 1).Value = c_pm Then
          GoTo kkk
        End If
        x2 = x2 + 1
      Loop
      Sheet2.Cells(x2, 1).Value = c_pm
kkk:   x1 = x1 + 1
    Loop
    '******
    x1 = 2
    Do While Not (IsEmpty(Sheet1.Cells(x1, 3).Value))
      c_pm = Sheet1.Cells(x1, 2).Value
      c_qy = Sheet1.Cells(x1, 3).Value
      n_je = Sheet1.Cells(x1, 5).Value
      x2 = 2
      Do While Not (IsEmpty(Sheet2.Cells(x2, 1).Value))
        If Sheet2.Cells(x2, 1).Value = c_pm Then
          y = 2
          Do While Not (IsEmpty(Sheet2.Cells(1, y).Value))
            If Sheet2.Cells(1, y).Value = c_qy Then
              y2 = y
            End If
            y = y + 1
          Loop
          Sheet2.Cells(x2, y2).Value = n_je + Sheet2.Cells(x2, y2).Value
         
        End If
        x2 = x2 + 1
      Loop
      x1 = x1 + 1
    Loop
End Sub

供复制粘贴用

再参考之前的“开支明细”转一转就OK

这种表叫做“交叉表”，你可以试试：

https://bbs.bc-cn.net/viewthread.php?tid=514525&page=1#pid2794178

调用方法：

USE mytable
jcbqh(ALIAS(),1,3,4,.T.) && 或者jcbqh('mytable',1,3,4)

参数1：为打开表的alias()，也就是别名，当前在哪个工作区无所谓，指定别名即可。
参数2：为字符字段，也就是竖轴的field(),指当前mytable中的第几个字段。
参数3：为字符字段，也就是横轴的field(),指当前mytable中的第几个字段。
参数4：为数值型或货币型字段，也就是交叉数值区的field(),指当前mytable中的第几个字段。
参数5：为逻辑型，.T. OR .F.，.T.为行列求和。.F.为不求和。

传入参数，自动转换成你想要表，就是X轴Y轴转换

[此贴子已经被作者于2025-11-17 19:22编辑过]

下列代码有点长，不知好不好简化，请高手赐教，谢谢！
CLEAR   ALL
CLOSE   ALL
cPath=ADDBS(JUSTPATH(SYS(16)))
SET   DEFAULT   TO   (cPath)
wjm=cPath+"\销售明细表.xls"
FileName=cPath+"\"+"销售统计表.doc"

* 创建Word应用程序对象
oWord = CREATEOBJECT("Word.Application")
oWord.Visible = .T.

* 创建新文档
oDoc = oWord.Documents.Add()

* 添加标题
oWord.Documents(1).range.Text = "销售统计表"
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1

* 连接Excel并读取数据
oExcel = CREATEOBJECT("Excel.Application")
oExcel.Visible = .F.
oWorkbook = oExcel.Workbooks.Open(wjm)
oSheet = oWorkbook.ActiveSheet

* 获取数据范围
nLastRow = oSheet.UsedRange.Rows.Count

* 创建临时表来存储Excel数据
CREATE   CURSOR   temp_data (订单号  C(10), 产品  C(20), 区域  C(10), 数量  N(5), 金额  N(10,2))

* 将Excel数据导入临时表
FOR   i = 2   TO   nLastRow
    lcOrder = ALLTRIM(TRANSFORM(oSheet.Cells(i, 1).Value))
    lcProduct = ALLTRIM(TRANSFORM(oSheet.Cells(i, 2).Value))
    lcArea = ALLTRIM(TRANSFORM(oSheet.Cells(i, 3).Value))
   
    * 获取金额
    lnQty = 0
    lnAmount = 0
   
    * 处理数量
    lcQtyValue = TRANSFORM(oSheet.Cells(i, 4).Value)
    IF   VARTYPE(lcQtyValue) = "C"   AND   !EMPTY(lcQtyValue)
        lnQty = VAL(lcQtyValue)
    ELSE
        lnQty = oSheet.Cells(i, 4).Value
    ENDIF
   
    * 处理金额
    lcAmountValue = TRANSFORM(oSheet.Cells(i, 5).Value)
    IF   VARTYPE(lcAmountValue) = "C"   AND   !EMPTY(lcAmountValue)
        lnAmount = VAL(lcAmountValue)
    ELSE
        lnAmount = oSheet.Cells(i, 5).Value
    ENDIF
   
    INSERT   INTO   temp_data   VALUES (lcOrder, lcProduct, lcArea, lnQty, lnAmount)
ENDFOR

* 获取所有不重复的区域
SELECT   DISTINCT   区域   FROM   temp_data   INTO   CURSOR   cur_areas   ORDER   BY   区域

* 获取所有不重复的产品
SELECT   DISTINCT   产品   FROM   temp_data   INTO   CURSOR   cur_products   ORDER   BY  产品

* 创建Word表格
nRows = RECCOUNT("cur_products") + 2  && 产品行 + 标题行 + 总计行
nCols = RECCOUNT("cur_areas") + 2     && 区域列 + 产品列 + 合计列

oTable = oDoc.Tables.Add(oDoc.Range(oDoc.Range.End-1, oDoc.Range.End-1), nRows, nCols)
oTable.Style = "网格型"

oWord.ActiveDocument.Tables(1).Range.Font.Bold=.F.
oWord.ActiveDocument.Tables(1).Range.Font.size=11
oWord.ActiveDocument.Tables(1).Range.Font.Name="宋体"
oWord.ActiveDocument.Tables(1).Rows(1).Range.Font.Bold=.t.

* 填充表头
oTable.Cell(1, 1).Range.Text = "产品"
SELECT   cur_areas
nCol = 2
SCAN
    oTable.Cell(1, nCol).Range.Text = ALLTRIM(区域)
    nCol = nCol + 1
ENDSCAN
oTable.Cell(1, nCols).Range.Text = "合计"

* 填充产品数据
SELECT   cur_products
nRow = 2
SCAN
    lcProduct = ALLTRIM(产品)
    oTable.Cell(nRow, 1).Range.Text = lcProduct
   
    * 计算每个区域的金额
    SELECT   cur_areas
    nCol = 2
    SCAN
        lcArea = ALLTRIM(区域)
        
        * 使用SQL查询计算金额 - 这是更可靠的方法
        SELECT   SUM(金额)   AS   area_sum   FROM   temp_data ;
        WHERE   ALLTRIM(产品) == lcProduct   AND   ALLTRIM(区域) == lcArea ;
        INTO   CURSOR   temp_area_sum
        
        IF   _TALLY > 0   AND   !ISNULL(temp_area_sum.area_sum)
            oTable.Cell(nRow, nCol).Range.Text = ALLTRIM(STR(temp_area_sum.area_sum, 10, 2))
        ELSE
            oTable.Cell(nRow, nCol).Range.Text = " "
        ENDIF
        
        nCol = nCol + 1
        USE   IN   temp_area_sum
    ENDSCAN
   
    * 计算产品合计
    SELECT   SUM(金额)   AS   product_sum   FROM   temp_data ;
    WHERE   ALLTRIM(产品) == lcProduct ;
    INTO   CURSOR   temp_product_sum
   
    IF   _TALLY > 0   AND   !ISNULL(temp_product_sum.product_sum)
        oTable.Cell(nRow, nCols).Range.Text = ALLTRIM(STR(temp_product_sum.product_sum, 10, 2))
    ELSE
        oTable.Cell(nRow, nCols).Range.Text = "0.00"
    ENDIF
   
    nRow = nRow + 1
    USE   IN   temp_product_sum
ENDSCAN

* 添加总计行
oTable.Cell(nRows, 1).Range.Text = "总计"

* 计算每个区域的总计
SELECT   cur_areas
nCol = 2
SCAN
    lcArea = ALLTRIM(区域)
   
    SELECT   SUM(金额)   AS   area_total   FROM   temp_data ;
    WHERE   ALLTRIM(区域) == lcArea ;
    INTO   CURSOR   temp_area_total
   
    IF   _TALLY > 0   AND   !ISNULL(temp_area_total.area_total)
        oTable.Cell(nRows, nCol).Range.Text = ALLTRIM(STR(temp_area_total.area_total, 10, 2))
    ELSE
        oTable.Cell(nRows, nCol).Range.Text = "0.00"
    ENDIF
   
    nCol = nCol + 1
    USE   IN   temp_area_total
ENDSCAN

* 计算整体总计
SELECT   SUM(金额)   AS   grand_total   FROM   temp_data   INTO   CURSOR   temp_grand
IF   _TALLY > 0   AND   !ISNULL(temp_grand.grand_total)
    oTable.Cell(nRows, nCols).Range.Text = ALLTRIM(STR(temp_grand.grand_total, 10, 2))
ELSE
    oTable.Cell(nRows, nCols).Range.Text = "0.00"
ENDIF

* 关闭Excel
oWorkbook.Close(.F.)
oExcel.Quit()

* 保存Word文档
oDoc.SaveAs(FileName)

* 清理对象
RELEASE   oSheet, oWorkbook, oExcel
RELEASE   oTable, oDoc, oWord

USE   IN   temp_data
USE   IN   cur_areas
USE   IN   cur_products
USE   IN   temp_grand
MESSAGEBOX("Word格式的销售统计表生成完成！", 64, "完成")

在10楼完成  E 到 D 的基础上，昨天一下午时间，依11楼代码修改调试，完成  D 到 W 部分

CLEAR ALL
SET SAFETY off
SET engi 70
CLOSE DATABASES
cPath=ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cPath)

FileName=cPath+"word_wj.doc"
oWord = CREATEOBJECT("Word.Application")       &&& 创建Word应用程序对象
oWord.Visible = .T.
oDoc = oWord.Documents.Add()                   &&& 创建新文档
oWord.Documents(1).range.Text = "销售统计表"   &&& 添加标题
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1
SELECT * from 统计表 into cursor tt         &&& 为创建Word表格准备（4句）
SELECT tt
nCols=FCOUNT()
nRows=RECCOUNT() + 2
oTable = oDoc.Tables.Add(oDoc.Range(oDoc.Range.End-1, oDoc.Range.End-1), nRows, nCols,1)   &&& 创建表格， 此句oTable.Style = "网格型" 被最后的 1 所替代
oWord.ActiveDocument.Tables(1).Range.Font.Bold=.F.
oWord.ActiveDocument.Tables(1).Range.Font.size=11
oWord.ActiveDocument.Tables(1).Range.Font.Name="宋体"
oWord.ActiveDocument.Tables(1).Rows(1).Range.Font.Bold=.t.   &&& 表格的第一行字体加粗
FOR i=1 to nCols
  oTable.Cell(1, i).Range.Text = FIELD(i)   &&& 填充表头
ENDFOR
nRow = 1
SELECT tt
GO top
SCAN  
  nRow = nRow + 1
  FOR i=1 to nCols
    lcPm = EVALUATE(FIELD(i))
    oTable.Cell(nRow, i).Range.Text = lcPm  &&& 填充“产品&金额”的数据
  ENDFOR
  SELECT tt
ENDSCAN
oTable.Cell(nRows, 1).Range.Text = "总计"   &&& 处理总计行
FOR i=2 to nCols
  sn=0
  SELECT tt
  SCAN
    sn=sn+EVALUATE(FIELD(i))
  ENDSCAN
  oTable.Cell(nRows, i).Range.Text =sn      &&& 记录每个区域的合计数
ENDFOR
FOR i=2 to nCols
  FOR j=2 to nRows
    IF oTable.Cell(j, i).Range.Text = "0"
      oTable.Cell(j, i).Range.Text = ""     &&& 清空 0 值
    ENDIF
  ENDFOR
ENDFOR
oDoc.SaveAs(FileName)                       &&& 保存Word文档
oDoc.close
oWord.quit
CLOSE DATABASES
MESSAGEBOX("Word格式的销售统计表生成完成！", 64, "提示：")
QUIT

谢谢！

为减少13楼的代码，设想总体粘贴，测试：

CLEAR ALL
SET SAFETY off
SET engi 70
CLOSE DATABASES
cPath=ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cPath)
USE 统计表               &&& 10楼已解决
COPY TO ls type xl5
FileName=cPath+"word_wj.doc"

oWord = CREATEOBJECT("Word.Application")       &&& 创建Word应用程序对象
oWord.Visible = .T.
oDoc = oWord.Documents.Add()                   &&& 创建新文档
oWord.Documents(1).range.Text = "销售统计表"   &&& 添加标题
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1
*---
oe=CREATEOBJECT("excel.application")
oe.visible=.T.
oe.DisplayAlerts = 0                      &&& 关闭EXCEL的对话框
oe.WorkBooks.Open(cpath+"ls.xls")         &&& 打开EXCEL文档
as = oe.ActiveSheet
as.UsedRange.copy                         &&& 拷贝用户数据区域
oWord.documents(1).range.pastespecial     &&& 粘贴表格

经粘贴后，观察：EXCEL上的表是粘贴过来了，可前一步添加的标题被覆盖掉了，如何解决？
麻烦高手赐教！谢谢！

没有通过，出现如下图


没找到 控制WORD光标位置的命令！

[此贴子已经被作者于2025-11-19 16:43编辑过]

没测试过
参考：https://learn.

学习了

学习了