【问题标题】:VBA code exits loop while calling macro from another workbook从另一个工作簿调用宏时 VBA 代码退出循环
【发布时间】:2017-11-13 03:48:10
【问题描述】:

下面提到的代码从工作簿中读取数据并将其存储在各种数组中,然后进入循环以打开另一个工作簿以在特定选项卡和位置输入存储在数组中的值。

一旦进入,它从新打开的工作簿中调用另一个子程序,子程序运行良好(需要 2-3 分钟)运行,但随后代码自动退出循环(我的意思是它不会打开循环中的下一个文件)。是因为被调用宏的处理时间吗?我可以就这个问题使用一些见解,这将非常有帮助。在此先感谢:)

Public strFileName As String
Public strfilename2 As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim ws As Worksheet
    Dim Tabnames() As Variant
    Dim celladdress() As Variant
    Dim values() As Variant
    Dim tabcount As Integer
    Dim filecount As Integer
    Dim j As Integer
    Dim k As Integer
    Dim i As Integer

strListSheet = "Data_Specifics"

Sheets(strListSheet).Select
tabcount = WorksheetFunction.CountA(Rows(6)) - 1
filecount = WorksheetFunction.CountA(Columns(2)) - 4

ReDim Tabnames(0, 0 To tabcount - 1)
ReDim celladdress(0, 0 To tabcount - 1)
ReDim values(0 To filecount - 1, 0 To tabcount - 1)

For k = 0 To tabcount - 1
Tabnames(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(6, k + 4).Value
celladdress(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(7, k + 4).Value
Next k

For j = 0 To filecount - 1
    For k = 0 To tabcount - 1
        values(j, k) = ActiveWorkbook.Sheets(strListSheet).Cells(j + 9, k + 4).Value
    Next k
Next j
Range("B8").Select
i = -1

Set currentWB = ActiveWorkbook
Do While ActiveCell.Value <> ""

    strFileName = ActiveCell.Offset(1, 1)
    strfilename2 = ActiveCell.Offset(1, 0)

    Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=False
    Set dataWB = ActiveWorkbook

    i = i + 1
        For k = 0 To tabcount - 1
        Sheets(Tabnames(0, k)).Select
        Range(celladdress(0, k)).Select
        If values(i, k) <> "XXXXX" Then
        Selection.Value = values(i, k)
        Else
        End If
        Next k

        strfilename2 = "'" & strfilename2 & "'" & "!ValidateDataNew"
        Application.Run strfilename2
        dataWB.Close SaveChanges:=True

    currentWB.Activate
    Sheets(strListSheet).Select
    ActiveCell.Offset(1, 0).Select
    i = i
Loop
Exit Sub

结束子

【问题讨论】:

  • 我怀疑这是因为您在循环中使用了 activecell,但是由于您正在打开其他工作簿,因此单元格不再处于活动状态。放入Debug.Print ActiveCell.Value并打开即时窗口;最后一个值是否对应于 B 列中列表中的最后一个值?
  • 您真的应该调查How to avoid using Select,因为它很有可能导致问题,但我还能想到另一件事;如果代码在打开的工作簿关闭之前停止,那么您的其他宏中可能有 End 语句。没有看到相关代码,我们是无法判断的。
  • 在循环条件下使用 activecell 是自找麻烦。而是使用计数器并完全引用您正在使用的单元格。

标签: vba excel


【解决方案1】:

为确保错误来自ValidateDataNew MACRO,让我们首先删除Sub GetData 代码中可能存在的错误。

我们应该消除您在使用SelectSelectionActiveCell 时可能遇到的所有错误。而是使用完全限定的 Range 对象。

用下面的代码替换你的Do While ActiveCell.Value &lt;&gt; ""循环:

Dim lRow As Long

Set currentWB = ActiveWorkbook
lRow = 8 ' start scanning from row 8

' use a loop with fully qualifed range, not select
Do While currentWB.Worksheets(strListSheet).Range("B" & lRow).Value <> ""

    strFileName = currentWB.Worksheets(strListSheet).Range("B" & lRow).Offset(1, 1)
    strfilename2 = currentWB.Worksheets(strListSheet).Range("B" & lRow).Offset(1, 0)

    Set dataWB = Workbooks.Open(strFileName, UpdateLinks:=False, ReadOnly:=False)

    i = i + 1
    For k = 0 To tabcount - 1
        If values(i, k) <> "XXXXX" Then
            dataWB.Worksheets(Tabnames(0, k)).Range(celladdress(0, k)).Value = values(i, k)
        Else
        End If
    Next k

    strfilename2 = "'" & strfilename2 & "'" & "!ValidateDataNew"
    Application.Run strfilename2

    dataWB.Close SaveChanges:=True
    Set dataWB = Nothing

    lRow = lRow + 1 ' advance the row by 1
Loop

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2018-02-15
    • 1970-01-01
    • 2013-09-01
    • 2023-03-26
    • 2021-01-11
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多