2017-09-07 13 views
0

私は他の4つのワークブックからデータを抽出しようとしている他のブックからデータを抽出した後に動作を停止した後、VBAは:Excelが

Excelは動作を停止し、再起動(そのうちのいくつかは、行の数千人を持っている場合があります)抽出が完了する。 私はシートの中にデータを抽出しましたので、最後のワークブックのデータが抽出された後にExcelが乱れていると仮定します。

また、1つのブックのみでテストし、終了後にクラッシュしました。

コピー&ペーストまたはクローズブックの後に "DoEvents"と "Application.Wait"を使用して、Excelで背景作業を完了できるとお伝えしました。私はそれを試みたが成功しなかった。

Excelが実行/再起動を停止する理由は何ですか?

は、ここに私のコードです:

Public sysExtractParamsDictionary As Scripting.dictionary 

'Sub rotine triggered when pressing button 
Sub Extract() 

    Set sysExtractParamsDictionary = mUtils.FillDictionary("sysParams", "tExtractParams") 'Sub rotine belonging to mUtils module to fill dictionary with values from my sysParams sheet. Contains the sheets name. 
    mClean.Clean  'Sub rotine belonging to mClean module to clear sheets 
    ExtractData [sysInputDirectory], "Input Sheet" 'Cell Name sysInputDirectory 
    ExtractData [sysR2Directory], "R1 Sheet" 
    ExtractData [sysR2Directory], "R2 Sheet" 
    ExtractData [sysR3Directory], "R3 Sheet" 

End Sub 

Sub ExtractData(sFilePath As String, sDictionaryKey As String) 

    Dim oWorkbook As cWorkBook 'Class Module 

    Set oWorkbook = New cWorkBook 

    mUtils.SetStatusBarMessage True, "Extracting " & sDictionaryKey & " ..." 'Sub rotine belonging to my mUtils module to set on or off status bar message 

    oWorkbook.WorkBookDirectory = sFilePath 
    oWorkbook.OpenWorkBook oWorkbook.WorkBookDirectory 
    oWorkbook.CopiesSourceSheetValuesToDestinationSheet sysExtractParamsDictionary(sDictionaryKey) 
    oWorkbook.CloseWorkBook (False) 

    DoEvents 
    DoEvents 
    Application.Wait (Now + TimeValue("0:00:05")) 
    DoEvents 

    Set oWorkbook = Nothing 

End Sub 

'#### Class Module 

Private wbWorkBook As Workbook 
Private sWorkBookDirectory As String 
Private sWorkBookName As String 
Private wsWorksheet As Worksheet 

Public Property Set Workbook(wbNew As Workbook) 
    Set wbWorkBook = wbNew 
End Property 

Public Property Get Workbook() As Workbook 
    Set Workbook = wbWorkBook 
End Property 

Public Property Let WorkBookDirectory(sFilePath As String) 
    sWorkBookDirectory = sFilePath 
End Property 

Public Property Get WorkBookDirectory() As String 
    WorkBookDirectory = sWorkBookDirectory 
End Property 

Public Property Let WorkBookName(sFileName As String) 
    sWorkBookName = sFileName 
End Property 

Public Property Get WorkBookName() As String 
    WorkBookName = sWorkBookName 
End Property 

Public Property Set Worksheet(wsNew As Worksheet) 
    Set wsWorksheet = wsNew 
End Property 

Public Property Get Worksheet() As Worksheet 
    Worksheet = wsWorksheet 
End Property 

Public Property Let WorkBookDirectory(sFilePath As String) 
    sWorkBookDirectory = sFilePath 
End Property 

Public Property Get WorkBookDirectory() As String 
    WorkBookDirectory = sWorkBookDirectory 
End Property 

'Class Module Function to Open WorkBook 
Public Sub OpenWorkBook(sFilePath As String) 

    Dim oFSO As New FileSystemObject 
    Dim sFileName As String 
    Dim sLog As String 

    sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path 

    If sFileName = "" Then 
     sLog = "Error. Not possible to retrieve File Name from Directory." 
    Else 
     Me.WorkBookName = sFileName 
     Set Me.Workbook = Workbooks.Open(sFilePath) 
     If wbWorkBook Is Nothing Then 
      sLog = "Error opening file: " & Me.WorkBookName 
     Else 
      sLog = "File successfully openned!" 
     End If 
    End If 

    Set oFSO = Nothing 

End Sub 

'Class Module Function to Copy Values from source to destination 
Public Sub CopiesSourceSheetValuesToDestinationSheet(wsDestinationName As Variant) 

    Dim wsDestination As Worksheet 
    Dim rStartRange As range 
    Dim rFullRangeToPaste As range 

    Set wsDestination = ThisWorkbook.Sheets(CStr(wsDestinationName)) ' Destination Sheet 
    Set Me.Worksheet = Me.Workbook.Sheets(1) 'Source Sheet 

    Set rStartRange = wsWorksheet.range("A1") 
    Set rFullRangeToPaste = wsWorksheet.range(rStartRange, mUtils.FindLast(3)) 'FindLast is a function belonging to mUtils module to find the last cell in worksheet 
    rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp) 

End Sub 

'Class Module Function to Close Workbook 
Public Sub CloseWorkBook(bSaveChanges As Boolean) 
    wbWorkBook.Saved = True 
    wbWorkBook.Close SaveChanges:=False 
End Sub 

'#### End Class Module 

私もクラスモジュールせずにそれを行うにしようとしました(念のために何かをオブジェクトと間違っていた)が、私はまだ同じ問題を持っています。

+0

質問は単純なバージョンのコード(クラスモジュールなし)に編集されました。問題は残っています。 –

答えて

0

他のブックからインポートしたシートに外部接続があり、ワークブックに接続と新しい参照を作成していました。理由はわかりませんが、何とか私のExcelに影響を及ぼしていて、すべてのシートの内容をコピーしていたので、再起動させてしまいました。私は唯一の値とソースシートのフォーマットをコピーし

rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp) 

代わりに私のワークブックへの完全なソースシートをコピーする

... ...

Dim rDestinationRange As Range 

'the rest of the code in question 

rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)

Set rDestinationRange = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp) 
    rFullRangeToPaste.Copy  
    wsDestination.PasteSpecial xlPasteValuesAndNumberFormats 

注:これは私のworkb前回の抽出(壊れた外部接続とヌル参照なし)から回復しました。その後、コードを変更して保存しました。