Question

所以，这就是我要做的事情：

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

基本上我试图自动将一系列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要复制的工作簿，并且你想要创建一个新的＆＃34; db.xls＆＃34;每次运行宏。基于这些假设，您需要做的就是在Do While循环中嵌入以'Open the workbook和objWorkbook.Worksheets("Sheet1").Range("A14").PasteSpecial开头的代码。我不确定的是如何控制循环。如果文件列表始终相同，那么您应该只在工作簿中的工作表中包含一个列表，该工作簿中包含宏并且只是迭代它。

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

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 - 自动化的格式化脚本

1 个答案: