将多个EXCEL表中部分固定单元格的内容整理提取到一张工作表中

  • Post author:
  • Post category:其他


Option Explicit
 
' 文件系统对象,用来操作文件/目录;
Private fso As New FileSystemObject
  
Sub 汇总当前目录下的文件()
    ' 得到当前工作簿所在目录的路径字符串;
    Dim strCurDir As String
    strCurDir = ThisWorkbook.Path
 
    ' 得到工作簿所在目录的文件夹对象;
    Dim objFolder As Folder
    Set objFolder = fso.GetFolder(strCurDir)
 
    ' i用于记录汇总表的当前行,由于数据从第二行开始,所以这里i=2;
    Dim i As Integer
    i = 2
 
    ' 得到当前工作簿的第一个工作表对象(也就是汇总表);
    Dim objSheet As Worksheet
    Set objSheet = ThisWorkbook.Sheets(1)
 
    ' 遍历汇总工作目录下的所有文件;
    Dim objFile As File
    For Each objFile In objFolder.Files
        ' 如果当前文件不是汇总文件(是数据文件),就打开,读取数据;
        If InStr(objFile.Name, "特采单清单汇总") = 0 Then
            ' 打开工作簿,并设置工作簿对象;
            Dim objBook As Workbook
            Set objBook = Workbooks.Open(objFile.Path)
 
            ' 设置第二个工作表对象,此对象对应每个数据文件;
            Dim objSheet2 As Worksheet
            Set objSheet2 = objBook.Sheets(1)
 
            ' 得到工作簿的主文件名;
            Dim strBookName As String
            objSheet.Cells(1, 1) = "名称"
            objSheet.Cells(1, 2) = "时间"
            strBookName = fso.GetBaseName(objBook.Name)
 
            ' 设置第i行的数据,有的来自文件名,有的来自目录名,有的来自数据表的指定位置;
            objSheet.Cells(i, 1) = "(" & strBookName & "工作表)" ' 附件
            objSheet.Cells(i, 2) = strBookName ' 发行时间
            objSheet.Cells(i, 3) = objFolder.Name ' 目录
            objSheet.Cells(i, 4) = objSheet2.Cells(3, 3) ' 品名
            objSheet.Cells(i, 5) = objSheet2.Cells(4, 3) ' 供应商
            objSheet.Cells(i, 6) = objSheet2.Cells(4, 5) ' 数量
            objSheet.Cells(i, 7) = objSheet2.Cells(5, 3) ' 原因
            ' 准备写入下一行
            i = i + 1
 
            ' 关闭当前的数据工作簿;
            objBook.Close
        End If
    Next
End Sub




版权声明:本文为qq_21036939原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。