编写一个程序，而不使用.activate / .select。 VBA

所以我在许多不同的地方在线阅读，我不应该使用.activate或类似的命令。 问题是我的程序HEAVILY依赖于他们。

首先给我一些背景。 我正在编写一个程序来自动化我的一部分工作。 几个月前，我已经写了这个代码的特定部分，它工作得很好。 但是，现在我试图更新代码的东西，使用工作是造成错误。 即ActiveCell.PasteSpecial的实例。 我读到，这是导致问题的.activate 。 为什么这只会造成一个问题呢？

至于主要问题，我需要我的代码做4件事情

1. 从特定单元获取帐号。
2. 将从外部程序复制的“sheet2”粘贴文本date激活到“A1”，并基于粘贴的数据从“sheet2”上的不同单元格中收集文本数据。
3. 激活“sheet1”粘贴收集的数据并接收下一个帐号。
4. 在Excel和另一个只接受键盘input的程序之间切换。 虽然这一步很烦人，但这不是我需要帮助的一步。

这是我到目前为止的代码。 我知道如何去做大部分的步骤，当我试图在没有.activate情况下完成这些步骤的时候，

  Sub Macro1() ' ' Macro1 Macro ' ' 'find missing emails Dim e As Range, Rang As Range Set Rang = Range("A2:A100") AppActivate "Microsoft Excel" Worksheets("Email_List").Activate Range("A1").Activate For Each e In Rang If Not IsEmpty(e.Value) = True Then ActiveCell.Offset(1, 0).Activate Sleep 700 ActiveCell.Offset(0, 3).Activate Sleep 700 If IsEmpty(ActiveCell.Value) Then ActiveCell.Offset(0, -3).Activate Sleep 700 ActiveCell.Copy Sleep 700 AppActivate "Other Program" Sleep 500 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "1", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "2", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "1", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "c ", True Sleep 700 SendKeys "^v", True Sleep 7001 SendKeys "^x", True Sleep 7000 SendKeys "^a", True Sleep 7000 SendKeys "^c", True Sleep 7000 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial Sleep 500 If Range("A24").Value = "CONF# NOT FOUND, PRESS <ENTER>" Then Sleep 700 AppActivate "Other Program" Sleep 500 SendKeys "~", True Sleep 700 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Email_List").Activate ElseIf Range("A24").Value = "ENTER RESERVATION NUMBER:" Then Range("D24").Activate ActiveCell.Value = "=LEFT(A6,6)" ActiveCell.Copy AppActivate "Other Program" Sleep 500 SendKeys "^v", True Sleep 700 SendKeys "30", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "^x", True Sleep 700 SendKeys "^a", True Sleep 700 SendKeys "^c", True Sleep 700 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial Sleep 500 If Range("A8").Value = "3. E-FOLIO" Then Sleep 700 AppActivate "Other Program" Sleep 500 SendKeys ("3") Sleep 700 SendKeys ("~") Sleep 700 SendKeys "^x", True Sleep 700 SendKeys "^a", True Sleep 700 SendKeys "^c", True Sleep 700 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial Sleep 700 Range("A21").Copy Worksheets("Email_List").Activate ActiveCell.Offset(0, 3).Activate ActiveCell.PasteSpecial ActiveCell.Offset(0, -3).Activate End If ElseIf Range("A2").Value = "===============================================================================" Then AppActivate "Other Program" Sleep 500 SendKeys "30", True Sleep 700 SendKeys "~", True Sleep 700 SendKeys "^x", True Sleep 700 SendKeys "^a", True Sleep 700 SendKeys "^c", True Sleep 700 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial Sleep 500 If Range("A8").Value = "3. E-FOLIO" Then Sleep 700 AppActivate "Other Program" Sleep 500 SendKeys ("3") Sleep 700 SendKeys ("~") Sleep 700 SendKeys "^x", True Sleep 700 SendKeys "^a", True Sleep 700 SendKeys "^c", True Sleep 700 AppActivate "Microsoft Excel" Sleep 500 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial Sleep 500 Range("A21").Copy Worksheets("Email_List").Activate ActiveCell.Offset(0, 3).Activate ActiveCell.PasteSpecial ActiveCell.Offset(0, -3).Activate End If End If Else ActiveCell.Offset(0, -3).Activate End If End If Next e End Sub 

任何帮助，您可以提供将不胜感激。

Answer 1

从这里开始：

 Worksheets("Email_List").Activate Range("A1").Activate 

ThisWorkbook中有一个工作表， 标记为 “Email_List”。 它的实际(Name)属性可能是Sheet12 ; 点击Ctrl + R打开Project Explorer ，然后select“Microsoft Excel Objects”文件夹下的“Email_List”表，然后按F4打开属性工具窗口。 find(Name)属性（应该是最上面的第一个），并将Sheet12 （或其他）更改为EmailListSheet 。

现在回到您的代码，您不再需要find工作表 – 您已经有了一个参考。

 EmailListSheet.Range("A1").Activate 

会做这件事情完全一样的东西：

 Worksheets("Email_List").Activate Range("A1").Activate 

但是你不想要。 .Activate范围。 相反，你想保留一个参考。 声明一个Rangevariables：

 Dim workingRange As Range Set workingRange = EmailListSheet.Range("A1") 

现在，而不是这个：

  ActiveCell.Offset(1, 0).Activate Sleep 700 ActiveCell.Offset(0, 3).Activate Sleep 700 

你可以这样做：

 Set workingRange = workingRange.Offset(1, 3) 

（不需要在这里睡觉）

接下来，您要查看该单元格是否为空：

 If IsEmpty(ActiveCell.Value) Then 

所以你只要做到这一点：

 If IsEmpty(workingRange.Value) Then 

然后你复制另一个像这样的单元格：

 ActiveCell.Offset(0, -3).Activate Sleep 700 ActiveCell.Copy 

不知道怎么了睡觉，但无论如何，你会这样做，而不是：

 workingRange.Offset(0, -3).Copy 

提示SendKeys ，粘贴到其他应用程序，并从其他应用程序复制，我们得到的部分炸毁：

 Worksheets("Data").Activate Cells.Activate Cells.Delete Range("A1").Activate ActiveCell.PasteSpecial 

同样的处理：命名工作表DataSheet并处理对该对象的引用。

 DataSheet.UsedRange.Clear DataSheet.Range("A1").PasteSpecial 

其余的更是相同的。

关键点：

• 为您的工作表命名并使用免费获得的全局引用，而不是在每次需要时从Worksheets集合中提取所有Worksheets 。
• 避免调用Range和Cells而不用Worksheet对象，如DataSheet.Range 。 当他们不合格时，这些成员隐式引用ActiveSheet ，这是你想要避免在这里。
• 一旦您的代码按预期工作，请将修改后的代码编辑到您的代码复审问题中，以重新打开该post，并重新审核您的新工作代码并进一步改进。