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

以上。