以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  目录下有多个excel文件,且里面有至少一个工作表sheet 怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=175390)

--  作者:cnsjroom
--  发布时间:2022/3/2 21:03:00
--  目录下有多个excel文件,且里面有至少一个工作表sheet 怎么用代码将它们合并成一个excel文件,且sheet名称以excel文件名称+sheet名称标注

目录下有多个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编辑过]

--  作者:有点蓝
--  发布时间: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
--  发布时间:2022/3/3 9:51:00
--  回复:(有点蓝)不要把vba和XLS.Book混用,他们不是一...

谢谢老师,按照你的指导,当前代码完成如下:实现了文件类型的筛选后再将多个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()


--  作者:有点蓝
--  发布时间:2022/3/3 9:56:00
--  
遍历所有文件,所有sheets,移到一个新的XLS.Book,然后保存即可
--  作者:cnsjroom
--  发布时间:2022/3/3 10:44:00
--  回复:(有点蓝)遍历所有文件,所有sheets,移到一个...

没有得到最佳处理

实现了拆分,但是没有把对应的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

 

 


--  作者:有点蓝
--  发布时间: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
--  发布时间:2022/3/3 11:00:00
--  回复:(有点蓝)If dlg.ShowDialog = DialogResult.O...

谢谢老师  

 

当前代码如下:实现了一个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
--  发布时间:2022/11/7 22:56:00
--  
今天从这篇文章中学到很多,解决了我今天晚上需要解决的问题,老师和咱们的楼主都挺厉害的