切换宏 VBA 运行缓慢

Question

我刚刚完成了我的第一个宏，但它似乎运行得非常慢，并且在几个循环之后它就死机了。在此之前我遇到了数据表示的问题，但我通过在第一行放置真实值来解决它。

宏的要点是每30秒在仪表板上显示不同的数据。

请在下面找到我的代码：

Public Sub Switch()
    Do
    With ActiveWorkbook.SlicerCaches("Slicer_country1")
        .SlicerItems("NL").Selected = True
        .SlicerItems("SP").Selected = False
        .SlicerItems("GB").Selected = False
    End With
    With ActiveWorkbook.SlicerCaches("Slicer_Project1")
        .SlicerItems("XX").Selected = True
        .SlicerItems("YY").Selected = False
        .SlicerItems("ZZ").Selected = False
        Application.Wait Now + TimeValue("00:00:30")
    End With
    With ActiveWorkbook.SlicerCaches("Slicer_Project1")
        .SlicerItems("XX").Selected = True
        .SlicerItems("YY").Selected = False
        .SlicerItems("ZZ").Selected = False
         Application.Wait Now + TimeValue("00:00:30")
    End With
    With ActiveWorkbook.SlicerCaches("Slicer_Project1")
        .SlicerItems("XX").Selected = True
        .SlicerItems("YY").Selected = False
        .SlicerItems("ZZ").Selected = False
         Application.Wait Now + TimeValue("00:00:30")
    End With
    Loop
End Sub

最近按时应用的解决方案，但它仅在最后一次调用时才能正常工作（我只得到想要的字段，在前 2 个其他按钮不会关闭），是否有任何解决方案可以在每次调用时只显示想要的值？

Dim CallNumber As Integer
Sub ScheduleChange()
Change
Application.OnTime Now + TimeValue("00:00:05"), "ScheduleChange"
End Sub

Sub Change()
CallNumber = CallNumber + 1
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = (CallNumber = 1)
.SlicerItems("YY").Selected = False
.SlicerItems("ZZ").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("YY").Selected = (CallNumber = 2)
.SlicerItems("XX").Selected = False
.SlicerItems("ZZ").Selected = False
End With
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("ZZ").Selected = (CallNumber = 3)
.SlicerItems("XX").Selected = False
.SlicerItems("YY").Selected = False
End With
If CallNumber = 3 Then
CallNumber = 0
End If
End Sub 

再次嗨，我使用下面的代码，但宏仍然不会一次显示一个按钮，它会从第一个按钮转到第二个按钮而不取消选择前一个按钮，是否有任何命令强制它一次只显示一个值？调试显示未设置对象变量或 With 块变量。

Dim CallNumber As Integer
Sub ScheduleChange()
Change
Application.OnTime Now + TimeValue("00:00:05"), "ScheduleChange"
End Sub

Sub Change()
CallNumber = CallNumber + 1
With ActiveWorkbook.SlicerCaches("Slicer_Project1")
.SlicerItems("XX").Selected = (CallNumber = 1)
.SlicerItems("YY").Selected = (CallNumber = 2)
.SlicerItems("ZZ").Selected = (CallNumber = 3)
End With
If CallNumber = 3 Then
CallNumber = 0
End If
End Sub

Answer 1

来自here

应用程序等待会冻结您的应用程序，并且不是管理延迟的非常有效的方法。

使用此延迟函数代替 Application.Wait

Private Sub delay(seconds As Long)
    Dim endTime As Date
    endTime = DateAdd("s", seconds, Now())
    Do While Now() < endTime
        DoEvents
    Loop
End Sub

Answer 2

正如 itChi 所说，使用 Application.Wait 将阻止 Excel。但我认为有一种比Do-Loop 和DoEvents 更好的方法——您可以尝试Application.OnTime 来安排您希望活动发生的时间：

你当前的代码是这样的：

Sub BlockingChange()
    Dim i As Integer
    i = 0
    Do
        Range("A1").Value2 = i
        Application.Wait Now + TimeValue("0:00:01")
        i = i + 1
    Loop
End Sub

...这完全阻止了 Excel。

OnTime 的替代方案是：

Sub NonBlockingChange()
    Update
    Application.OnTime Now + TimeValue("0:00:01"), "NonBlockingChange"
End Sub

Sub Update()
    Range("A1").Value2 = CInt(Range("A1").Value2) + 1
End Sub

现在请注意，每次运行此命令时，它都会安排另一个正在运行的 sub 实例，因此如果您运行宏两次，它将每秒运行 sub 两次，等等。

要取消这些排队的事件，只需将False 作为第四个参数传递：

Sub StopChanges()

On Error GoTo Catch
    Application.OnTime Now + TimeValue("0:00:01"), "NonBlockingChange", , False
    Exit Sub
Catch:
    MsgBox ("Nothing to stop")

End Sub

这应该对你很有用。只需将 Update 的正文替换为您要更改的内容，并将 1 秒超时更改为您的值。

编辑

Lukas，在您编辑的代码中，您刚刚将 Application.Wait 换成了 Application.OnTime。它们不一样，您需要以不同的方式使用它们，请再次阅读示例以了解如何使用。

从您编辑的代码中，您需要更改以下内容：

• 不再有 Do-Loop。阅读上面的示例，我们不再需要循环，OnTime 调用将设置一个时间表来调用您的子
• OnTime 需要一个参数，它是要调用的 sub 的名称
• 因此，这意味着您需要稍微重构（更改）代码以使用新结构

像这样的东西（你需要剪裁并完成它）：

Dim CallNumber As Integer
Sub ScheduleChange()
    Change
    Application.OnTime Now + TimeValue("0:00:10"), "ScheduleChange"
End Sub

Sub Change()
    'Select a different slicer on each call to this function
    CallNumber = CallNumber + 1
    With ActiveWorkbook.SlicerCaches("Slicer_Project1")
        .SlicerItems("XX").Selected = (CallNumber = 1)
        .SlicerItems("YY").Selected = (CallNumber = 2)
        .SlicerItems("ZZ").Selected = (CallNumber = 3)
    End With

    ' When it gets to 3, roll over to the first one again
    If CallNumber = 3 Then
        CallNumber = 0
    End If
End Sub

然后要启动它，您可以调用ScheduleChange。将这些函数放在它们自己的模块中，否则会出现“无法运行宏”错误。