将 Excel 表格解析到单独的文件中

引言

您可能在 Excel 中创建了过多的工作表，现在您想将这些工作表移动到单独的文件中。是的，您可以通过右键单击工作表并将其“移动/复制”到“新工作簿”来完成此操作，但是，如果单元格中超过 255 个字符会怎样？它会被截断。是的，您可以复制/粘贴并比较单元格，直到将所有单元格都移动过去，但这很繁琐。

使用代码

这是一个使用 Excel 2003 的 Visual Basic 6.3 创建的 Excel VB 宏。以下是代码细节（如果您想要完整的代码片段，请跳到最后）。

更高级别的概述是：

1. 循环遍历每个工作表。
   1. 创建一个新的工作簿，并将旧工作表的名称复制到新的工作表之一。
   2. 复制旧工作簿中的Range数据。
   3. 从旧工作簿中收集列宽和行高。
   4. 将Range数据粘贴到新的工作簿中。
   5. 更新新工作簿中的列宽和行高数据。
   6. 保存新工作簿并关闭它。
2. 对其余工作表重复此操作。

首先，我们需要循环遍历当前工作簿中的每个工作表。

For Each ws In Worksheets
    ' do some stuff on each worksheet.
Next ws

接下来，我们需要获取工作表的名称，以便稍后在我们的For循环中使用。

' get the current worksheet's name.
wsName = ws.Name

然后，我创建一个新的工作簿，它将接受我们要复制的工作表。是的，这也可以在代码的后面完成，但我选择在这里完成。我们还使用我们要复制的工作表重命名第一个工作表。

'Create a new book, rename the sheet to new name.
Workbooks.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = wsName

接下来，我们将返回到原始 Excel 文件（请注意，您必须将文本从“要复制的当前文件.xls”重命名为您的文件名）。我们还选择要复制的工作表和单元格范围。在我的示例中，我只选择了 A-AA 列和 1-2000 行。

' start the copy process to the new workbook.
Application.CutCopyMode = False
Windows("Your Current File to be copied.xls").Activate
Sheets(wsName).Select
Range("A1:AA2000").Select

然后，我们想将列宽和行高值存储在一个数组中，用于新的工作表，因为仅复制范围不会将格式复制过来。

' set the array sizes to the range expected
' for rows and columns from previous line.
Dim prevColumnWidth(40)
Dim prevRowHeight(2000)
 
' cycle through the cell range and get each cell w/h data points.
For c = 1 To 40 Step 1
    prevColumnWidth(c - 1) = Columns(c).ColumnWidth
Next c

For c = 1 To 2000 Step 1
    prevRowHeight(c - 1) = Rows(c).RowHeight
Next c

现在，我们实际上将单元格复制到新的工作簿中。需要注意的是，只允许打开要复制的工作簿，否则此脚本将无法正常工作。

' now copy the cell range and paste into the new workbook.
Range("A1:AA2000").Select
Selection.Copy
Windows(2).Activate
Range("A1:AA2000").Select
ActiveSheet.Paste

接下来，我们要将原始列宽和行高带到新的工作簿中。

' now resize all the cells in the new workbook.
For c = 1 To 40 Step 1
    Columns(c).ColumnWidth = prevColumnWidth(c - 1)
Next c

For c = 1 To 2000 Step 1
    Rows(c).RowHeight = prevRowHeight(c - 1)
Next c

现在所有内容都复制完毕，我们要保存工作簿，然后关闭它。

' default save location is My Documents or the last opened folder. Not sure exactly.
ActiveWorkbook.SaveAs Filename:="Your new File as copied_" & wsName & ".xls", _
          FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close

以下是完整的代码脚本

Sub CopyRnge2newBook()
'
' CopyRnge2newBook Macro
' Authored by Rich Elswick
'
For Each ws In Worksheets
 
  ' get the current worksheet's name.
  wsName = ws.Name

  'Create a new book, rename the sheet to new name.
  Workbooks.Add
  Sheets("Sheet1").Select
  Sheets("Sheet1").Name = wsName

  ' start the copy process to the new workbook.
  Application.CutCopyMode = False
  Windows("Your Current File to be copied_.xls").Activate
  Sheets(wsName).Select
  Range("A1:AA2000").Select

  ' set the array sizes to the range expected
  ' for rows and columns from previous line.
  Dim prevColumnWidth(40)
  Dim prevRowHeight(2000)

  ' cycle through the cell range and get each cell w/h data points.
  For c = 1 To 40 Step 1
    prevColumnWidth(c - 1) = Columns(c).ColumnWidth
  Next c
  For c = 1 To 2000 Step 1
    prevRowHeight(c - 1) = Rows(c).RowHeight
  Next c

  ' now copy the cell range and paste into the new workbook.
  Range("A1:AA2000").Select
  Selection.Copy
  Windows(2).Activate
  Range("A1:AA2000").Select
  ActiveSheet.Paste

  ' now resize all the cells in the new workbook.
  For c = 1 To 40 Step 1
    Columns(c).ColumnWidth = prevColumnWidth(c - 1)
  Next c
  For c = 1 To 2000 Step 1
    Rows(c).RowHeight = prevRowHeight(c - 1)
  Next c
 
  ' default save location is My Documents
  ' or the last opened folder. Not sure exactly.
  ActiveWorkbook.SaveAs Filename:="Your new File as copied_" & wsName & _
       ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
       ReadOnlyRecommended:=False, CreateBackup:=False
  ActiveWorkbook.Close

  Next ws
End Sub

关注点

注意，您应该只打开一个计划要解析的文件，否则脚本可能无法正常工作。此外，此脚本仅复制 37 列和 2000 行数据。这对于您可能执行的大多数操作都足够了。已标记为将来升级。

是的，VB 很糟糕，但是如果您想快速地在 Excel 中完成一些事情，那么在需要时可以使用它。它在其编程世界的一小部分中非常强大，有时也很有用。当然，我使用的 VB 编辑器的版本有很多不足之处，所以要根据实际情况看待。

历史

• 初始版本 - 2008 年 9 月 12 日。