VBA实例-从Excel整理数据到Word

实现目录

功能需求
- 数据结构
- 复制数据到新sheet并分类数据
- - 添加序号、日期、时间三列数据
  - - 添加序号列
    - 添加时间列
  - 将名称和类别复制到word文件中
  - - 将参数5和参数9中的一个复制到word文件中
- 实例

功能需求

1、将原始数据中不要的数据剔除
2、原始数据中增加序号、日期和时间三列数据，并且按报名类别进行分类。
3、形成时间表
4、将名称和类别复制到评分表中，一个名称一个word文档
5、将数据中的参数5和参数9复制到评分表中

数据结构

在这里插入图片描述

复制数据到新sheet并分类数据

If CheckIsExistsSheetName("时间表") ThenThisWorkbook.Sheets("时间表").DeleteEnd IfApplication.DisplayAlerts = TrueFor i = 2 To SumRowsrefValue = SourceSheet.Cells(i, 5) * 1If refValue > finalValue ThenfinalValue = refValueEnd IfNext iFor TargetDeviceSerialNumber = 1 To finalValueSet Gradeword = wdapp.Documents.Open(ThisWorkbook.Path & "\评分表.docx")Debug.Print Gradeword.Tables(1).Cell(3, 1).Range.TextGradeword.Sentences(2).Characters(27) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 3).Text Gradeword.Sentences(2).Characters(8) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 2).Text jj = 3For j = 2 To SumRowsrefValue = SourceSheet.Cells(j, 5) * 1If refValue = TargetDeviceSerialNumber ThenUseRows = UseRows + 1SourceSheet.Rows(j).Copy DestSheet.Cells(UseRows, 1)If IsEmpty(SourceSheet.Cells(j, 10)) ThenGradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 14).TextElseGradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 10).TextEnd Ifjj = jj + 1End IfNext jarr(TargetDeviceSerialNumber) = UseRows'Debug.Print'Gradeword.SaveAs2 (ThisWorkbook.Path + "\" + EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 2).Text + "评分表" + "(" + EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 3).Text + ")" + ".docx")Gradeword.CloseSet Gradeword = NothingNext TargetDeviceSerialNumberfinalRows = UseRowsDestSheet.Columns("A:D").DeleteDestSheet.Range("C1").EntireColumn.Insert '序号DestSheet.Range("C1").EntireColumn.Insert '日期DestSheet.Range("C1").EntireColumn.Insert '时间DestSheet.Range("C1") = "序号"DestSheet.Range("D1") = "日期"DestSheet.Range("E1") = "时间"DestSheet.Cells(2, 5) = "9:00"For k = 2 To SumRowsDestSheet.Cells(k, 3) = "=COUNT($C$1:C" & (k - 1) & ")+1"Next kFor kk = 2 To SumRows - 1Day_mod = kk Mod (AM_ContrlRow + PM_ContrlRow)If Day_mod < AM_ContrlRow + 1 ThenDestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"ElseIf Day_mod = AM_ContrlRow + 1 ThenDestSheet.Cells(Day_mod + 1, 5) = "14:00"ElseDestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"End IfNext kk

添加序号、日期、时间三列数据

添加序号列

往单元格中添加公式”=COUNT($C$1:C(k-1))+1“即可生成序号。

For k = 2 To SumRowsDestSheet.Cells(k, 3) = "=COUNT($C$1:C" & (k - 1) & ")+1"Next k

添加时间列

往单元格中添加类似于”=TEXT(E2+“0:10”,“h:mm”)“的公式，即可生成每隔10分钟的序列。

**For kk = 2 To SumRows - 1Day_mod = kk Mod (AM_ContrlRow + PM_ContrlRow)If Day_mod < AM_ContrlRow + 1 ThenDestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"ElseIf Day_mod = AM_ContrlRow + 1 ThenDestSheet.Cells(Day_mod + 1, 5) = "14:00"ElseDestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"End IfNext kk**

将名称和类别复制到word文件中

Gradeword.Sentences(2).Characters(27) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 3).Text Gradeword.Sentences(2).Characters(8) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 2).Text 这两句语句是将
在这里插入图片描述
中的名称和类别分别填写到对应的word文件档-----"评分表.docx"中名称和类别处

即：

将参数5和参数9中的一个复制到word文件中

将参数5和参数9中的一个复现到 "评分表.docx"中参数5/参数9这列中

If IsEmpty(SourceSheet.Cells(j, 10)) ThenGradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 14).TextElseGradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 10).TextEnd Ifjj = jj + 1