一个.xlsx多个链接的工作表如何分解成单独的工作表文件,以后如何重新组合?

一个非IT相关的类已经被分配了一个组项目,他们所做的工作将被存储在一个.xlsx文件中。 成员们决定协同编辑这个文件的最好方法是把它分成组成单,把每个* .xlsx表单上传到一个SVN仓库,并使用锁和一个.txt文件来组织表单/成员的责任。

该小组已经完成了所述文件与VB脚本分裂(礼貌这个美妙的网站),如下所示:

Sub SaveSheets() Dim strPath As String Dim ws As Worksheet Application.ScreenUpdating = False strPath = ActiveWorkbook.Path & "\" For Each ws In ThisWorkbook.Sheets ws.Copy 'Use this line if you want to break any links: BreakLinks Workbooks(Workbooks.Count) Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx" Next Application.ScreenUpdating = True End Sub Sub BreakLinks(wb As Workbook) Dim lnk As Variant For Each lnk In wb.LinkSources(xlExcelLinks) wb.Breaklink lnk, xlLinkTypeExcelLinks Next End Sub 

因此,该小组现在有一个存储库,其中每个成员当前正在编辑它们各自的文件。 接下来的问题是,我们如何自动将这些文件重新统一为一个.xlsx文件同时保留原有的链接。

编辑4/2:开始赏金//我知道链接被上面的脚本“打破了”,但我不完全确定这是什么意思,虽然我怀疑它会使重新组装保留原始链接更困难。 应该指出的是,有链接的原始文件仍然可用,可能会被用来协助解决这个问题。

编辑4/2:Excel版本是2010年 – 当前文件中不存在原始链接。

编辑4/3:原始链接不在当前文件中,但希望重新统一原始链接(从原始未编辑文件,预分割)被重新创build/保留。

如果您有SharePoint,则可以全部更新相同的Excel(2003或2010)书籍。

http://office.microsoft.com/en-us/excel-help/about-shared-workbooks-HP005262294.aspx

链接然后不真正应用在解决scheme,正如你所说,原来没有任何链接,所以重新链接不需要。

所提供的脚本甚至有embedded评论说:“如果你想打破任何链接使用此行:”。 因此,如果您将下面的行注释掉(在行前添加'),它将保留子工作簿中的链接。

使用上一个问题的答案复制到另一个工作簿重新组装可以使用以下VBA完成:

 Sub CombineSheets() Dim strPath As String Dim ws As Worksheet Dim targetWorkbook As Workbook Set targetWorkbook = ActiveWorkbook Application.ScreenUpdating = False 'Adjust path location of split files strPath = "C:\code\xls-split" Dim str As String 'This can be adjusted to suit a filename pattern. str = Dir(strPath & "\*.xl*") Do Until str = "" 'Open Workbook x and Set a Workbook variable to it Set wbResults = Workbooks.Open(strPath & "\" & str, UpdateLinks:=0) For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count) Next Sheet wbResults.Close SaveChanges:=False str = Dir() Loop Application.ScreenUpdating = True End Sub 

这会将其他工作簿附加到当前打开的工作簿。

Sourced replaceFileSearch函数的代码来查找目录中的xls文件。

我们可能需要更多的细节来帮助你,但是你也许能够完成你所需要的东西(也许这可以启动一个解决scheme):

  • 循环浏览工作簿中的工作表
  • 对于每张纸
    • 打开相应的xlsx文件
    • 识别非公式单元格
    • 对于每个细胞
      • 复制到主工作簿中的相同位置
    • closuresxlsx文件

下面是一个例子(基于你的SaveSheets代码)。 如果你尝试这个,一定要先备份一切。 我们显然不知道电子表格是如何布置以及如何使用的。 如果搞砸了,真的很糟糕。 另外,还有一些假设:

  • xlsx文件中的布局和使用范围与原始工作簿中的布局和使用范围完全相同。
  • 您所指的链接是公式(或者到另一个工作表或另一个工作簿)。

如果这些假设是错误的,则需要适当修改(标识特定范围以复制和/或向例程添加更强大的逻辑)。

请注意,这样做的实际代码非常短。 我添加了评论和基本的error handling,大大增加了代码量。

此代码将被添加到原始工作簿。

 Sub RetrieveSheets() Dim strPath As String Dim ws As Worksheet Dim ws2 As Worksheet Dim wbk As Workbook Dim rng As Range Application.ScreenUpdating = False strPath = ActiveWorkbook.Path & "\" For Each ws In ThisWorkbook.Sheets 'Open the xlsx file (read only) Set wbk = Nothing On Error Resume Next Set wbk = Workbooks.Open(strPath & ws.Name & ".xlsx", ReadOnly:=True) On Error GoTo 0 'Continue if xlsx file was successfully opened If Not wbk Is Nothing Then Set ws2 = Nothing On Error Resume Next Set ws2 = wbk.Worksheets(ws.Name) On Error GoTo 0 'Continue if appropriate sheet was found If Not ws2 Is Nothing Then 'Identify cells to copy over (cells that are constants) For Each rng In ws2.Cells.SpecialCells(xlCellTypeConstants) 'set the cell value equal to the identical cell location in the xlsx file If (Left(ws.Range(rng.Address).Formula, 1)) <> "=" Then ws.Range(rng.Address) = rng End If Next Set ws2 = Nothing End If 'Close the xlsx file wbk.Close False End If Next Set wbk = Nothing Application.ScreenUpdating = True 

结束小组

这是我如何做到这一点的粗略概述:

  1. 使用Office2013而不是 Office 2010
  2. 用原来的.xlsx任务文件创buildtmp /目录。
  3. 在tmp /
  4. 使用拆分表模块(在此页面上列出),但注释掉断开链接的行。
  5. 将所有生成的.xlsx文件放入源文件(可以删除原始的.xlsx文件)
  6. 遥远来源/文件夹的第一张,并将其放置../
  7. 打开第一张表格,并导入/使用此页面上列出的“combineheets”模块。
  8. 保存工作表,重新打开它,你会被提示更新链接。 这样做,然后select“更改来源”,然后在步骤6中select第一张纸张Re。
  9. 链接会自动更新; 完成。

注意:你必须保存一个文件为启用macros,…

看看这个MSDN文章合并来自多个工作簿(.xls / .xlsx)文件的数据

http://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx

我不太了解VBA,但我认为这就是你要找的。

另外请注意,它并不需要文本文件来pipe理文件