Excel学习~数据批量导入 (快速复制)

对于同类型 Excel 文件,一个个粘贴复制似乎比较麻烦,特别是文件量比较大的时候。程序的目的既是为了解决此类大量重复性劳动,今天给大家分享一个快速上传 Excel 数据,其实就是快速复制的小技巧。

对于文件上传,我们首先需要保证两份文档格式统一,因为 Excel 对于复制的数据如果格式不同意会报错。以下面两份实例文件格式为例,简单给下上传文件的代码,其他文件格式可做参照。

原始文档格式

 

目标文档格式

具体代码如下:

Sub startCopy()
    Dim folder As String
    Dim count As Integer
    Dim theBook As Workbook

    theFile = Application.GetOpenFilename(FileFilter:="Micrsoft Excel文件(*.xls), *.xls")
    Set theBook = Workbooks.Open(theFile)

    If theFile = "" Then
        MsgBox "未选择任何文件!"
        Exit Sub
    ElseIf theBook.Sheets(1).Range("A4") = "序号/层号" Then
        bool = CopyFile(theFile, 5, 1, 5)
        MsgBox "文件上传成功,请仔细核对!"
    Else
    
        theBook.Close
        MsgBox "文件格式不对,请仔细检查!"
    End If

End Sub

'复制数据
Function CopyFile(fileName, sStartRow, sStartCol, tStartRow)

    Dim sBook As Workbook
    Dim sSheet As Worksheet
    Dim rc As Integer

   'copyRowNum = 0

    If fileName = (ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then
        Exit Function
    End If

    Set sBook = Workbooks.Open(fileName) '打开目标工作簿
    Set sSheet = sBook.Sheets(1) '使用第一个sheet作为源数据所在页

    sEndRow = sSheet.Cells(Rows.count, sStartCol + 1).End(xlUp).Row '获取源文件中最后一行数据所在行(第二列)
    sEndCol = sSheet.Cells(sStartRow - 1, Columns.count).End(xlToLeft).Column ' 获取源文件中最后一列数据所在列(标题行)

    If sEndRow >= srcStartLine Then
        sSheet.Range(Cells(sStartRow, sStartCol), Cells(sEndRow, sEndCol)).Copy ThisWorkbook.Sheets(1).Range("B" & tStartRow) '复制到指定位置
        'copyRowNum = sEndRow - srcStartLine + 1
    End If

    sBook.Close

End Function

以上。

恭喜,此资源为免费资源,请先
注意:本站资源多为网络收集,如涉及版权问题请及时与站长联系,我们会在第一时间内与您协商解决。如非特殊说明,本站所有资源解压密码均为:blog.quietguoguo.com。
未经允许不得转载

文章标题:蝈蝈要安静 » Excel学习~数据批量导入

原文链接:https://blog.quietguoguo.com/3959.html

发布信息:文章由【蝈蝈要安静】于<2020-04-19>发布于【Excel】分类下

相关标签:||

相关推荐

评论 抢沙发

  • 昵称(必填)
  • 邮箱(必填)
  • QQ(选填)
  • 网址(选填)