请教一个在WORD中做统计的问题

ddddddddd

8vhNosAm.rar (8.62 KB, 下载次数: 35)

2005-4-22 17:38 上传

点击文件名下载附件
请教一个在WORD中做统计的问题

各位大侠您好。向您请教一个在WORD中做统计的方法。

具体想法如下：具体资料见附件，我主要是想在WORD中实现象EXCEL一样的统计功能，主要表现在对每个人作一次统计（包括平均价格，合计金额），最后再对所有人员做一次总计（平均价格，累计金额）。

请教如何用VBA代码实现这个功能！！

请赐教，不胜感激！

守柔

你确信你的正式文档同你的上传文件格式一致吗？

特别是同一个人处于表格的连续单元格区域中吗？

ddddddddd

能，上传格式与实际格式一样，同一人名处于连续单元格中。

多谢版主赐教。

守柔

这种东东，置于EXCEL中，更方便。

SUMIF，AVERAGE，SUM就可以搞定了。

以下代码，只是纯粹从理论上研究WORD表格中的计算，当然，也可以使用WORD域的方法进行；本代码中使用了数组的方法和调用EXCEL进行计算，仅供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-4-23 6:35:25 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit '运行此代码前请确认VBE/工具/引用:勾选对Microsoft Excel 10.0(版本而异) Object Library的引用 Sub ExampleToCalculateInArray() Dim MyArray1() As Double, MyArray2() As Double Dim TotalArray1() As Double, TotalArray2() As Double Dim i As Integer, RowsCount As Integer, N As Integer Dim MyVal1 As Double, MyVal2 As Double Dim ExlApp As New Excel.Application Dim strName As String Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument.Tables(1) RowsCount = .Rows.Count '获得表格总行数 For i = 2 To RowsCount - 1 '从第二行到最后第二行间循环 '取得第八列和第九列的数据,用VAL函数转化为数值类型 MyVal1 = VBA.Val(ActiveDocument.Range(.Cell(i, 8).Range.Start, .Cell(i, 8).Range.End)) MyVal2 = VBA.Val(ActiveDocument.Range(.Cell(i, 9).Range.Start, .Cell(i, 9).Range.End)) ReDim Preserve TotalArray1(i - 2) '声明动态数组并扩充该数组 ReDim Preserve TotalArray2(i - 2) ReDim Preserve MyArray1(N) ReDim Preserve MyArray2(N) '将值分别写入四个数组中 TotalArray1(i - 2) = MyVal1: TotalArray2(i - 2) = MyVal2 MyArray1(N) = MyVal1: MyArray2(N) = MyVal2 N = N + 1 '累加 '如果下一行中的数据(人名)与上一行不同时 If .Cell(i + 1, 2).Range <> .Cell(i, 2).Range Then '取得姓名文本 strName = ActiveDocument.Range(.Cell(i, 2).Range.Start, .Cell(i, 2).Range.End - 1) '写入文档最后 ActiveDocument.Content.InsertAfter Chr(13) & strName & "平均价格:" & ExlApp.WorksheetFunction _ .Average((MyArray1)) & "合计金额" & ExlApp.WorksheetFunction.Sum((MyArray2)) & Chr(13) '初始化两个数组(清空) Erase MyArray1: Erase MyArray2 N = 0 '初始化N变量 End If Next End With '在文档末尾插入平均值和总计值 ActiveDocument.Content.InsertAfter Chr(13) & "平均价格:" & ExlApp.WorksheetFunction.Average(TotalArray1) _ & "累计金额" & ExlApp.WorksheetFunction.Sum(TotalArray2) Set ExlApp = Nothing '释放对象 Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

守柔

使用数组与EXCEL的好处是，还可以进行更多对此数据的计算与统计。

以下方法，是简单的累加与平均值计算，亦供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-4-23 07:29:51 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub ExampleToEasy() Dim i As Integer, RowsCount As Integer, N As Integer, M As Integer Dim SumValue1 As Double, SumValue2 As Double Dim TotalValue1 As Double, TotalValue2 As Double, strName As String Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument RowsCount = .Tables(1).Rows.Count '取得表格总行数 For i = 2 To RowsCount - 1 '从第二行开始到最后第二行 N = N + 1 '累计数 '数据累加 SumValue1 = SumValue1 + VBA.Val(.Range(.Tables(1).Cell(i, 8).Range.Start, .Tables(1).Cell(i, 8).Range.End - 1)) SumValue2 = SumValue2 + VBA.Val(.Range(.Tables(1).Cell(i, 9).Range.Start, .Tables(1).Cell(i, 9).Range.End - 1)) TotalValue1 = TotalValue1 + VBA.Val(.Range(.Tables(1).Cell(i, 8).Range.Start, .Tables(1).Cell(i, 8).Range.End - 1)) TotalValue2 = TotalValue2 + VBA.Val(.Range(.Tables(1).Cell(i, 9).Range.Start, .Tables(1).Cell(i, 9).Range.End - 1)) If .Tables(1).Cell(i + 1, 2).Range <> .Tables(1).Cell(i, 2).Range Then '取得人名 strName = .Range(.Tables(1).Cell(i, 2).Range.Start, .Tables(1).Cell(i, 2).Range.End - 1) '插入平均价格和合计金额 .Content.InsertAfter Chr(13) & strName & "平均价格:" & SumValue1 / N & "合计金额" & SumValue2 & Chr(13) N = 0: SumValue1 = 0: SumValue2 = 0 '初始化三变量 End If Next '在文档最后插入平均价格与累计金额 .Content.InsertAfter Chr(13) & "平均价格:" & TotalValue1 / (RowsCount - 2) & "累计金额" & TotalValue2 End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

ddddddddd

非常感谢守老师。

不过，您做的结果和我想的有一点问题，我是想在每个人名的下面自动插入一合计行，最后插入一汇总行。形如附件：请问我的想法在WROD中能实现吗？

谢谢守老师!!!

bFwoV6Di.rar (11.6 KB, 下载次数: 13)

2005-4-26 19:22 上传

点击文件名下载附件
请教一个在WORD中做统计的问题

守柔

只以做到以下状况了，强烈建议使用EXCEL的分类汇总功能！

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-4-27 08:40:15 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'请在运行本过程前删除最后一行合计行!!!!!!!!!!!! Sub Example() Dim i As Integer, RowsCount As Integer, ForNumber As Integer On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument.Tables(1) RowsCount = .Rows.Count '表格总行数 For i = RowsCount To 2 Step -1 '循环 ForNumber = ForNumber + 1 '计数(为获得单元区域) If i = RowsCount Then .Rows(i).Select '选中最后一行 With Selection .InsertRowsBelow 1 '下方插入 .Shading.BackgroundPatternColor = wdColorLightGreen .Font.Bold = True '粗体 End With .Cell(i + 1, 1).Range.Text = "合计" .Cell(i + 1, 8).Formula Formula:="=Average(Above)" '计算平均值的公式域 .Cell(i + 1, 9).Formula Formula:="=Sum(Above)" '计算总和的公式域 .Range.Fields.Unlink '断开域链接,转为文本 End If If .Cell(i - 1, 2).Range <> .Cell(i, 2).Range Then .Rows(i).Select With Selection .InsertRowsAbove 1 '在上方插入 .Shading.BackgroundPatternColor = wdColorGray20 .Font.Bold = True '粗体字 End With .Cell(i, 1).Range.Text = "小计" .Cell(i, 2).Range.Text = VBA.Left(.Cell(i + 1, 2).Range, Len(.Cell(i + 1, 2).Range) - 2) .Cell(i, 8).Formula Formula:="=Average(h" & i & ":h" & i + ForNumber & ")" .Cell(i, 9).Formula Formula:="=Sum(i" & i & ":i" & i + ForNumber & ")" ForNumber = 0 '复零 .Range.Fields.Unlink '断开域链接,转为文本 End If Application.ScreenUpdating = True '恢复屏幕更新 Next End With End Sub '----------------------

守柔

这是成品，请参：（只能做到这个情况了，不过，应该完全能够满足楼主的要求）

D3A0pSZs.zip (16.33 KB, 下载次数: 25)

2005-4-27 08:44 上传

点击文件名下载附件
请教一个在WORD中做统计的问题

ddddddddd

守老师!

感谢至胜，无言以表。强烈建议置精。