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

实现目录

功能需求

1、将原始数据中不要的数据剔除

2、原始数据中增加序号、日期和时间三列数据,并且按报名类别进行分类。

3、形成时间表

4、将名称和类别复制到评分表中,一个名称一个word文档

5、将数据中的参数5和参数9复制到评分表中

数据结构

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

bash 复制代码
If CheckIsExistsSheetName("时间表") Then
        ThisWorkbook.Sheets("时间表").Delete
    End If
    Application.DisplayAlerts = True
   For i = 2 To SumRows
        refValue = SourceSheet.Cells(i, 5) * 1
        If refValue > finalValue Then
            finalValue = refValue
        End If
   Next i
   For TargetDeviceSerialNumber = 1 To finalValue
        Set Gradeword = wdapp.Documents.Open(ThisWorkbook.Path & "\评分表.docx")
        Debug.Print Gradeword.Tables(1).Cell(3, 1).Range.Text
        Gradeword.Sentences(2).Characters(27) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 3).Text 
        Gradeword.Sentences(2).Characters(8) = EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 2).Text 
        jj = 3
        For j = 2 To SumRows
             refValue = SourceSheet.Cells(j, 5) * 1
             If refValue = TargetDeviceSerialNumber Then
                UseRows = UseRows + 1
                SourceSheet.Rows(j).Copy DestSheet.Cells(UseRows, 1)
                If IsEmpty(SourceSheet.Cells(j, 10)) Then
                    Gradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 14).Text
                Else
                    Gradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 10).Text
                End If
                jj = jj + 1
             End If
         Next j
        arr(TargetDeviceSerialNumber) = UseRows
        'Debug.Print'
        
        Gradeword.SaveAs2 (ThisWorkbook.Path + "\" + EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 2).Text + "评分表" + "(" + EquipSectionsheet.Cells(TargetDeviceSerialNumber + 1, 3).Text + ")" + ".docx")
        Gradeword.Close
        Set Gradeword = Nothing
    Next TargetDeviceSerialNumber
    finalRows = UseRows
    DestSheet.Columns("A:D").Delete
    DestSheet.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 SumRows
        DestSheet.Cells(k, 3) = "=COUNT($C$1:C" & (k - 1) & ")+1"
    Next k
    
    For kk = 2 To SumRows - 1
        Day_mod = kk Mod (AM_ContrlRow + PM_ContrlRow)
        If Day_mod < AM_ContrlRow + 1 Then
            DestSheet.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 Then
            DestSheet.Cells(Day_mod + 1, 5) = "14:00"
        Else
            DestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"
        End If
    Next kk

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

添加序号列

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

bash 复制代码
For k = 2 To SumRows
        DestSheet.Cells(k, 3) = "=COUNT($C$1:C" & (k - 1) & ")+1"
    Next k
添加时间列

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

bash 复制代码
**For kk = 2 To SumRows - 1
        Day_mod = kk Mod (AM_ContrlRow + PM_ContrlRow)
        If Day_mod < AM_ContrlRow + 1 Then
            DestSheet.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 Then
            DestSheet.Cells(Day_mod + 1, 5) = "14:00"
        Else
            DestSheet.Cells(Day_mod + 1, 5) = "=TEXT(E" & kk & "+" & Chr(34) & "0:10" & Chr(34) & "," & Chr(34) & "h:mm" & Chr(34) & ")"
        End If
    Next 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这列中

bash 复制代码
If IsEmpty(SourceSheet.Cells(j, 10)) Then
                    Gradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 14).Text
                Else
                    Gradeword.Tables(1).Cell(jj, 2).Range = SourceSheet.Cells(j, 10).Text
                End If
                jj = jj + 1

实例

实例

相关推荐
一名技术极客44 分钟前
Vue2 doc、excel、pdf、ppt、txt、图片以及视频等在线预览
pdf·powerpoint·excel·文件在线预览
用余生去守护1 小时前
【反射率】-- Lab 转换(excel)
excel
进击的六角龙1 小时前
Python中处理Excel的基本概念(如工作簿、工作表等)
开发语言·python·excel
TracyDemo1 小时前
excel功能
excel
lc寒曦1 小时前
【VBA实战】用Excel制作排序算法动画
排序算法·excel·vba
zzzgd8161 小时前
easyexcel实现自定义的策略类, 最后追加错误提示列, 自适应列宽,自动合并重复单元格, 美化表头
java·excel·表格·easyexcel·导入导出
努力学习技能的LY1 小时前
Excel:vba实现批量插入图片批注
excel
图片转成excel表格3 小时前
wps怎么算出一行1和0两种数值中连续数值1的个数,出现0后不再计算?
excel·wps
Jacob程序员3 小时前
java导出word文件(手绘)
java·开发语言·word
q2498596933 小时前
前端预览word、excel、ppt
前端·word·excel