別のワークブックからマクロを呼び出すときにVBAコードがループを終了する

Question

以下のコードは、ワークブックからデータを読み取り、さまざまな配列に格納した後、別のワークブックを開いて特定のタブおよび場所。

一度入力すると、新たに開かれたブックのサブルーチンが呼び出され、サブルーチンが正常に実行され（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 

End Subの

Answer 1

、エラーがValidateDataNew MACROから来ていることを確認しますのは、最初のあなたがSub GetDataコードを持っている可能性のあるエラーを削除できるようにします。

Select、Selection、ActiveCellを使用すると発生する可能性のあるエラーをすべて削除する必要があります。代わりに、完全修飾のRangeオブジェクトを使用してください。

は、以下のコードを使用してDo While ActiveCell.Value <> ""ループを交換してください：

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