Question

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

首先让我先介绍一下背景。我正在编写一个程序来自动完成我的部分工作。几个月前我已经编写了这段特殊代码，它运行得非常好。但是现在我正在尝试更新代码，用于工作的东西会导致错误。即ActiveCell.PasteSpecial的实例。我读到导致问题的是.activate。为什么这只会导致问题呢？

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

从特定单元格中获取帐号。
激活“sheet2”将从外部程序复制的文本日期粘贴到“A1”，并根据粘贴的数据从“sheet2”上的不同单元格中收集文本数据。
激活“sheet1”粘贴收集的数据并接收下一个帐号。
在Excel和另一个只接受键盘输入的程序之间切换。虽然这一步令人讨厌，但这不是我需要帮助的步骤。

这是我到目前为止的代码。我知道如何在没有.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中有一张标有＆＃34; Email_List＆＃34;的工作表。它的实际(Name)属性可能是Sheet12;点击 Ctrl + R 打开 Project Explorer ，然后选择＆＃34; Email_List＆＃34; ＆＃34; Microsoft Excel Objects＆＃34;下的工作表单击文件夹，然后单击 F4 以显示属性工具窗口。找到(Name)属性（应该是第一个属性）并将Sheet12（或其他）更改为EmailListSheet。

现在回到您的代码，您不再需要找到工作表 - 您已经对它进行了引用。

EmailListSheet.Range("A1").Activate

将做与此完全相同的事情：

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

但你不想.Activate范围。相反，您希望保留对它的引用。声明Range变量：

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

Cue SendKeys，粘贴到其他应用程序，并从复制其他应用程序，然后我们到达爆炸的部分：

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

相同的交易：工作表DataSheet的名称，并处理对该对象的引用。

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

其余的更多相同。

关键点：

为您的工作表命名并使用您免费获得的全局参考，而不是每次需要时从Worksheets集合中获取所有工作表。

如果不使用Range对象对其进行限定，请避免致电Cells和Worksheet，例如DataSheet.Range。如果他们没有资格，这些成员会隐含地引用ActiveSheet，这是您想要避免的。

一旦您的代码按预期工作，请将修改后的代码编辑为your Code Review question以重新打开该帖子，并对您的新工作代码进行审核并进一步改进。

不使用.activate / .select编写程序。 VBA

1 个答案: