Excel VBA - 自动化格式化脚本

Question

这就是我想要做的事情：

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

基本上，我正在尝试自动将 excel 个文件提取到一个有组织的文件中。每个脚本调用都应该提取到它自己的 sheet，因此没有被覆盖的信息。

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

' 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"的宏。基于这些假设，您需要做的就是将以 'Open the workbook 和 objWorkbook.Worksheets("Sheet1").Range("A14").PasteSpecial 开头的代码嵌套在 Do While 循环中。我不确定的是如何控制循环。如果文件列表始终相同，您应该只在包含宏的工作簿中的 sheet 上包含一个列表，然后遍历它。

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

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。

Excel VBA - 自动化格式化脚本

Excel VBA - Formatting script for automation

excel

automation

vba