Foxtable(狐表)用户栏目专家坐堂 → 目录下有多个excel文件,且里面有至少一个工作表sheet 怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注


  共有5104人关注过本帖树形打印复制链接

主题:目录下有多个excel文件,且里面有至少一个工作表sheet 怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注

帅哥哟,离线,有人找我吗?
cnsjroom
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
目录下有多个excel文件,且里面有至少一个工作表sheet 怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注  发帖心情 Post By:2022/3/2 21:03:00 [只看该作者]

目录下有多个excel文件,且里面有至少一个工作表sheet  怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注

麻烦老师们指导下  谢谢!

比如张.excel (sheet1 sheet2 sheet3) 、李.excel(名单)

组合成:汇总表.excel(张sheet1 张sheet1 张sheet1 李名单)

 

当前代码如下:

Dim dlg As New FolderBrowserDialog
Dim wj  As String
If dlg.ShowDialog = DialogResult.Ok Then
    'MessageBox.Show("你选择的目录是:" & dlg.SelectedPath,"提示")
    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
        If FileSys.GetName(wj).Contains("xls")  Then
            output.show(wj)  '输出所有符合条件的文件
            Dim App As New MSExcel.Application
            Dim Wb As MSExcel.Workbook = App.WorkBooks.open(wj)
            output.show(Wb.WorkSheets.Count)
            Dim Book1 As New XLS.Book(wj)
            Dim mbwj As String= "d:\汇总表2.xlsx"
            wb.saveas(mbwj)
            Dim Book2 As New XLS.Book(mbwj)
            For i As Integer = Wb.WorkSheets.Count To 0 Step -1
                Dim Sheet = Book1.Sheets(i)
                'Book1.Sheets.Remove(Sheet)
                Book2.Sheets.Add(Sheet)
                Book2.Save(mbwj)
            Next
            wb.close()
            App.Quit
        End If
    Next
End If

 

运行提示错误如下:

 
图片点击可在新窗口打开查看此主题相关图片如下:22.png
图片点击可在新窗口打开查看

且也没有将选择的目录下所有的xls文件按照上述要求全部合成一个表


[此贴子已经被作者于2022/3/2 22:27:16编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107024 积分:544351 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/3/3 9:21:00 [只看该作者]

不要把vba和XLS.Book混用,他们不是一个东西

Dim dlg As New FolderBrowserDialog
Dim wj  As String
If dlg.ShowDialog = DialogResult.Ok Then
    'MessageBox.Show("你选择的目录是:" & dlg.SelectedPath,"提示")
Dim Book1 As New XLS.Book 
            Dim mbwj As String= "d:\汇总表2.xlsx"
    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
dim ss() as string = FileSys.GetName(wj).split(".")
        If ss(1) ="xls" Then
            output.show(wj)  '输出所有符合条件的文件
            Dim Book2 As New XLS.Book(wj)
            For i As Integer = Book2.Sheets.Count - 1 To 0 Step -1
                Dim Sheet = Book2.Sheets(i)
                Book2.Sheets.Remove(Sheet)
sheet.name = ss(0) & sheet.name
                Book1.Sheets.Add(Sheet)
            Next
        End If
    Next
Book1.Save(mbwj 
End If

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)不要把vba和XLS.Book混用,他们不是一...  发帖心情 Post By:2022/3/3 9:51:00 [只看该作者]

谢谢老师,按照你的指导,当前代码完成如下:实现了文件类型的筛选后再将多个excel合并再一个excel文件中

现在反过来,有没有办法将这个已经汇总表的excel,将多个sheet拆分成以sheet名称单个命名的excel文件呢?这个excel文件的sheet名称就时拆分前的sheet名称

 

如:汇总表.xls(sheet1  名单)

拆分成  名单(名单)  sheet1(sheet1)两个excel

 

当前代码如下:

Dim dlg As New FolderBrowserDialog
Dim wj  As String
Dim Proc As New Process '定义一个新的Process
Dim mbwj As String= "d:\" & format(Date.Now,"yyyyMMddhhddss") & "汇总表.xlsx"
If dlg.ShowDialog = DialogResult.Ok Then
    output.Show("你选择的目录是:" & dlg.SelectedPath)
    Dim Book1 As New XLS.Book
    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
        If file.Contains(".xls") Then
            Dim ss() As String = FileSys.GetName(wj).split(".")
            output.show(ss(0))
            output.show(ss(1))
            output.show(wj)  '输出所有符合条件的文件
            Dim Book2 As New XLS.Book(wj)
            For i As Integer = Book2.Sheets.Count - 1 To 0 Step -1
                Dim Sheet = Book2.Sheets(i)
                Book2.Sheets.Remove(Sheet)
                sheet.name = ss(0) & sheet.name
                Book1.Sheets.Add(Sheet)
            Next
        End If
    Next
    Book1.Save(mbwj)
End If
Proc.File = mbwj '指定要打开的文件
Proc.Start()


 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107024 积分:544351 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/3/3 9:56:00 [只看该作者]

遍历所有文件,所有sheets,移到一个新的XLS.Book,然后保存即可

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)遍历所有文件,所有sheets,移到一个...  发帖心情 Post By:2022/3/3 10:44:00 [只看该作者]

没有得到最佳处理

实现了拆分,但是没有把对应的sheet数据对应sheet名称为文件中

麻烦老师看看  谢谢!

 

 

当前代码如下:

Dim dlg As New FolderBrowserDialog
Dim wj  As String
Dim Proc As New Process '定义一个新的Process

If dlg.ShowDialog = DialogResult.Ok Then
    output.Show("你选择的目录是:" & dlg.SelectedPath)
    Dim Book1 As New XLS.Book
    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
        If file.Contains(".xls") Then
            Dim ss() As String = FileSys.GetName(wj).split(".")
            output.show(ss(0))
            output.show(ss(1))
            output.show(wj)  '输出所有符合条件的文件
            Dim Book2 As New XLS.Book(wj)
            For i As Integer = Book2.Sheets.Count - 1 To 0 Step -1
                Dim Sheet = Book2.Sheets(i)
                Book2.Sheets.Remove(Sheet)
                'Book1.Sheets.Add(Sheet)
                Book1.Sheets.Insert(0,sheet.name)
                sheet.name = ss(0) & sheet.name
                Dim mbwj As String= "d:\拆分结果\" & ss(0) & sheet.name & ".xlsx"
                Book1.Save(mbwj)
            Next
        End If
    Next
End If

 

 


 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107024 积分:544351 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/3/3 10:50:00 [只看该作者]

If dlg.ShowDialog = DialogResult.Ok Then
    output.Show("你选择的目录是:" & dlg.SelectedPath)

    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
        If file.Contains(".xls") Then
            Dim ss() As String = FileSys.GetName(wj).split(".")
            output.show(ss(0))
            output.show(ss(1))
            output.show(wj)  '输出所有符合条件的文件
            Dim Book2 As New XLS.Book(wj)
            For i As Integer = Book2.Sheets.Count - 1 To 0 Step -1
                Dim Sheet = Book2.Sheets(i)
                Book2.Sheets.Remove(Sheet)
                sheet.name = ss(1) & sheet.name
    Dim Book1 As New XLS.Book
                Book1.Sheets.Insert(0,sheet)
                Dim mbwj As String= "d:\拆分结果\" & ss(0) & sheet.name & ".xlsx"
                Book1.Save(mbwj)
            Next
        End If
    Next
End If

 回到顶部
帅哥哟,离线,有人找我吗?
cnsjroom
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1571 积分:11238 威望:0 精华:0 注册:2021/1/17 17:06:00
回复:(有点蓝)If dlg.ShowDialog = DialogResult.O...  发帖心情 Post By:2022/3/3 11:00:00 [只看该作者]

谢谢老师  

 

当前代码如下:实现了一个excel拆分多个  并且删除默认开始的sheet

Dim dlg As New FolderBrowserDialog
Dim wj  As String
Dim Proc As New Process '定义一个新的Process

If dlg.ShowDialog = DialogResult.Ok Then
    output.Show("你选择的目录是:" & dlg.SelectedPath)
   
    For Each File As String In FileSys.GetFiles(dlg.SelectedPath)
        wj=File
        If file.Contains(".xls") Then
            Dim ss() As String = FileSys.GetName(wj).split(".")
            output.show(ss(0))
            output.show(ss(1))
            output.show(wj)  '输出所有符合条件的文件
            Dim Book2 As New XLS.Book(wj)
            For i As Integer = Book2.Sheets.Count - 1 To 0 Step -1
                Dim Sheet = Book2.Sheets(i)
                Book2.Sheets.Remove(Sheet)
                'Book1.Sheets.Add(Sheet)
                sheet.name = ss(0) & sheet.name
                Dim Book1 As New XLS.Book
                Dim Sheet1 = Book1.Sheets(0)
                Book1.Sheets.Remove(Sheet1)
                Book1.Sheets.Insert(0,sheet)
               
                Dim mbwj As String= "d:\拆分结果\" & ss(0) & sheet.name & ".xlsx"
                Book1.Save(mbwj)
            Next
        End If
    Next
End If


 回到顶部
帅哥哟,离线,有人找我吗?
lrsea
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:113 积分:1180 威望:0 精华:0 注册:2010/7/3 17:03:00
  发帖心情 Post By:2022/11/7 22:56:00 [只看该作者]

今天从这篇文章中学到很多,解决了我今天晚上需要解决的问题,老师和咱们的楼主都挺厉害的

 回到顶部