Question

这是我有关此宏的第二篇文章。尽管第一篇文章收到了一些答复，但没有一个答复能解决问题（不过感谢您的答复）。

场景：我有大约20个子电子表格，其中包含指向外部资源的链接。每个电子表格的链接数量从500到10,000不等。主电子表格会调用宏以依次打开每个子电子表格并更新链接。每个子电子表格都有一个仪表板，可以告诉我还有多少链接需要更新。通过计算每个选项卡中“ N / A”值的数量，然后将这些计数求和到单元格A20中，即可完成此操作。随着链接的更新，A20中的值将递减为零。

Sub Sub01()
    Dim NAtotal As Integer

    Set ActiveWKB = Workbooks.Open("Sub01.xlsm")

    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.CalculateFull
    ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

    NAtotal = Worksheets("Dashboard").Cells(20, "C").Value
    MsgBox (NAtotal)    'Tells me how many cells remain to be updated – starts off at 4450.

    NAtotal = 100   'Debugging effort to let me know that NAtotal does adjust.
    MsgBox (NAtotal)

    Do Until NAtotal = 0
       Application.ScreenUpdating = True
       MsgBox (NAtotal) 'Another debugging effort to monitor NAtotal. Starts at 100, then jumps to (and remains at) 4450 on the second loop and all subsequent loops.

       NAtotal = Worksheets("Dashboard").Cells(20, "C").Value   'Resets NAtotal to the value in C20. This never changes, but remains at 4450.

       DoEvents

    Loop

    Application.Calculation = xlManual
    MsgBox ("Done")

    Sheets("Dashboard").Activate
    Range("B1").Select

    ActiveWorkbook.Save
    ActiveWindow.Close

End Sub`

宏应继续循环，直到单元格A20达到零，然后停止。单元格A20确实递减计数，但变量NAtotal仍保持其初始值。

感谢任何指导/建议。

Answer 1

嗨，下面的代码对我有用。尝试使用相同的方法而不是循环。计划将每秒触发一次，直到逻辑上NATotal = 0。只需更新代码以适合您的参考即可。

Public firstOpen As Boolean

Sub testForm()
Dim cellCount As Integer
Dim s1 As Sheet1
Set s1 = Sheet1
Dim cellCol As Integer
Dim activeWbk As Workbook
Dim ws As Worksheet

If firstOpen = False Then
 firstOpen = True
 Set activeWbk = Workbooks.Open("C:\Example\Link2.xlsm")
 Set ws = activeWbk.Sheets("Sheet1")
 Application.Calculation = xlCalculationAutomatic
 Application.CalculateFull
 activeWbk.UpdateLink Name:=ActiveWorkbook.LinkSources
 CreateNewSchedule
 Exit Sub
Else
 Set activeWbk = Workbooks("Link2.xlsm")
 Set ws = activeWbk.Worksheets("Sheet1")
End If


cellCount = ws.Range("N2").Value



If cellCount = 0 Then
 MsgBox ("Done...")
 Application.Calculation = xlCalculationManual
 firstOpen = false 
Else
  Debug.Print cellCount
  CreateNewSchedule

End If

'Application.Calculation = xlCalculationManual

End Sub

Sub CreateNewSchedule()
Application.OnTime Now + TimeValue("00:00:01"), Procedure:="testForm", Schedule:=True
End Sub

链接更新时暂停VBA脚本

1 个答案: