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


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

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

帅哥,在线噢!
有点蓝
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110572 积分:562750 威望: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

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110572 积分:562750 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/3/3 9:56:00 [显示全部帖子]

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

 回到顶部
帅哥,在线噢!
有点蓝
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110572 积分:562750 威望: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

 回到顶部