Excel VBA - 自动化格式化脚本

Question

这就是我想要做的：

1. 打开文件：Pc_Profile
2. 创建新工作表：Sheet1
3. 将所需单元格从 Pc_Profile 复制到 Sheet1（参见下面的脚本）
4. 将整个 Sheet1 复制到新的 excel 文件：db.xls
5. 将工作表重命名为单元格 A5 的内容
6. 为下一次脚本运行创建新工作表

基本上，我正在尝试将大量 excel 文件自动提取到一个有组织的文件中。每个脚本调用都应提取到自己的工作表中，以免信息被覆盖。

这是我到目前为止所做的工作。它只是将所需的单元格复制到同一文件中的新工作表中。

' Create Excel object
Set objExcel = CreateObject("Excel.Application")

' Open the workbook
Set objWorkbook = objExcel.Workbooks.Open _
    ("\\[directory]\Pc_Profile.xls")

' Set to True or False, whatever you like
objExcel.Visible = True


objWorkbook.Worksheets("Pc_Profile").Range("A5:D5").Copy
objWorkbook.Worksheets("Sheet1").Range("A1").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A8:B8").Copy
objWorkbook.Worksheets("Sheet1").Range("A2").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A13:B13").Copy
objWorkbook.Worksheets("Sheet1").Range("A3").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A15:D17").Copy
objWorkbook.Worksheets("Sheet1").Range("A4").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A24:E26").Copy
objWorkbook.Worksheets("Sheet1").Range("A7").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A28:B30").Copy
objWorkbook.Worksheets("Sheet1").Range("A10").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A43:B43").Copy
objWorkbook.Worksheets("Sheet1").Range("A13").PasteSpecial

objWorkbook.Worksheets("Pc_Profile").Range("A45:B45").Copy
objWorkbook.Worksheets("Sheet1").Range("A14").PasteSpecial

' Activate Sheet2 so you can see it actually pasted the data
objWorkbook.Worksheets("Sheet2").Activate 

我真的很感激额外的推动。我正在为一个工作项目自动执行此操作，并且没有使用 VB 的经验 - 我只是在旅途中了解到这一点。

Answer 1

在我回答你的实际问题之前，有几件事是很好的做法：

1) 在代码中完成任何实际工作之前，您希望长时间运行的任何宏都应该有Application.ScreenUpdating = False，这告诉 Excel 不要费心更改屏幕上显示的内容（大大提高性能）。请务必在代码末尾附近添加Application.ScreenUpdating = True

2) 与 #1 类似，您通常希望包含 Application.Calculation = xlManual 以提高性能。如果您的宏需要从大范围的单元格中获取准确的最新值，则让计算保持自动可能会更容易，但在这种情况下似乎并非如此。

3) 您不需要创建新的 Excel 实例（这是您的第一行代码所做的）。您已经处于一个非常好的 Excel 实例中。这也使您不必在宏结束时关闭另一个实例（或者更糟糕的是，忘记这样做并且内存被实际上没有使用的 Excel 进程占用）

至于您的具体问题，听起来您有更多要从中复制 Pc_profile 的工作簿，并且您希望在每次运行宏时创建一个新的“db.xls”。基于这些假设，您需要做的就是在 Do While 循环中嵌套以 'Open the workbook 和 objWorkbook.Worksheets("Sheet1").Range("A14").PasteSpecial 开头的代码。我不确定的是如何控制循环。如果文件列表始终相同，您应该只在包含宏的工作簿中的工作表上包含一个列表，然后对其进行迭代。

为了便于编码和使循环更有效，您应该做的另一件事是声明和使用 Worksheet 变量，并将每个工作簿的 if 设置为相应的工作表以从中提取数据。例如。

Dim ws as Worksheet

'The Dim is outside your loop, but this would be inside it
Set ws = objWorkbook.Worksheets("whatever_the_sheet's_name_is")

通过这种方式，您可以将每次出现的objWorkbook.Worksheets("Pc_Profile"). 替换为ws.，更易于键入、更易于阅读、更易于更新且不易出错。

接下来，您实际上没有将 Sheet1 移动到新工作簿或重命名它的代码。要移动它（以及尚未创建的其他 Sheet1），您应该在进入 Do While 循环之前，拥有以下

Dim target as Workbook
Set target = Application.Workbooks.Add

然后在循环快结束时，你需要objWorkbook.Worksheets("Sheet1").Move Before:=Target.Sheets(1)

最后，在将 Sheet1 从 Pc_Profile 移出并重命名后，您需要包含 objWorkbook.Close SaveChanges:=False。