vb_ncw 2015-03-25 00:35 采纳率: 0%
浏览 4539

vb.net 读取多个excel表中的数据填到新建的excel表中,

Option Explicit On
Module Module1
Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean
Dim i As Integer
Dim strSrcFile As String
Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer
Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object
Dim numarr As System.Array
On Error Resume Next
If Right(strPath, 1) <> "\" Then strPath = strPath & "\" '如果需要合并文件中的工作表数量小于1则退出
'如果需要合并文件中的工作表数量小于1则退出

If SheetCount < 1 Then Exit Function
'删除掉该路径下原来的合并文件
If Dir(strPath & "合并后的文件.xls") <> "" Then Kill(strPath & "合并后的文件.xls")
'获得第1个XLS文件
strSrcFile = Dir(strPath & "*.xls")
'如果文件不存在则退出
If Len(strSrcFile) = 0 Then Exit Function
'创建一个Excel实例
xlApp = CreateObject("Excel.Application")
'新建一个工作簿

    xlNewBook = xlApp.Workbooks.Add
    '调整新建工作簿里工作表的数量
    ReDim nNewRows(0 To SheetCount)
    For i = 0 To SheetCount - xlNewBook.Sheets.Count
        xlNewBook.Sheets.Add()
        xlNewBook.Sheets(xlNewBook.Sheets.Count)
    Next
    '循环查找当前路径下的所有XLS文件
    Do
        '打开找到的XLS文件
        xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)
        '循环复制源XLS文件里的工作表
        nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)
        For i = 1 To nSheets
            xlSheet = xlSrcBook.Sheets(i)
            '获得源XLS文件中第i个工作表实际数据的行列数

            nRows = xlSheet.range("i2").value
            nCols = xlSheet.UsedRange.Columns.Count

            '使用范围对象粘贴源XLS文件数据到合并结果文件中


            xlRange = xlSheet.Range(xlSheet.Cells(7, 1), xlSheet.Cells(nRows + 7, nCols)).ToString

            xlRange.Select()
            xlRange.Copy()
            xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 3).PasteSpecial(&HFFFFEFF8)
            '保存合并结果文件中第i个工作表的行数
            nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count



        Next

        '关闭打开的源XLS文件

        xlSrcBook.close()
        '继续查找下一个XLS文件
        strSrcFile = Dir()
    Loop Until Len(strSrcFile) = 0
    '保存并关闭合并结果文件
    xlNewBook.SaveAs(strPath & "合并后的文件.xls")

    xlNewBook.Close()
    '退出Excel实例
    xlApp.quit()
    '释放资源
    Erase nNewRows
    xlRange = Nothing
    xlSheet = Nothing
    xlNewBook = Nothing
    xlSrcBook = Nothing
    If Err.Number = 0 Then MergeXlsFile = True
End Function

End Module
button 调用模块。复制的功能实现了。就是因为原单元格中有公式。可是复制过来统一列退后两行。但是公式还是制定原来的单元格,读取的值就变不一样了。该怎么办能把之前的单元格只读出value。然后填入。

  • 写回答

1条回答

  • angelance 2015-07-23 13:21
    关注

    用range.value2试试看

    评论

报告相同问题?

悬赏问题

  • ¥20 求数据集和代码#有偿答复
  • ¥15 关于下拉菜单选项关联的问题
  • ¥15 如何修改pca中的feature函数
  • ¥20 java-OJ-健康体检
  • ¥15 rs485的上拉下拉,不会对a-b<-200mv有影响吗,就是接受时,对判断逻辑0有影响吗
  • ¥15 使用phpstudy在云服务器上搭建个人网站
  • ¥15 应该如何判断含间隙的曲柄摇杆机构,轴与轴承是否发生了碰撞?
  • ¥15 vue3+express部署到nginx
  • ¥20 搭建pt1000三线制高精度测温电路
  • ¥15 使用Jdk8自带的算法,和Jdk11自带的加密结果会一样吗,不一样的话有什么解决方案,Jdk不能升级的情况