2017-12-13 5 views
1

いくつかのxlsmファイルにアクセスしてスプレッドシートを取り出し、それを値として貼り付けるマクロがあります。しかし、主にxlsmファイルを開くのに多くの時間がかかるため、マクロのオープンに多くの時間がかかります。このロード時間を短縮できる方法はありますか?xlsmファイルにアクセスする時間を最小限に抑えるにはどうすればよいですか?

これは私が持っているコードです:

周りの迅速な検索を行う
Option Explicit 

Sub GetSheets() 
Dim Path As String 
Dim Filename As String 
Dim wbMaster As Workbook 
Dim wbActive As Workbook 
Dim wsPanel As Worksheet 

Set wbMaster = ThisWorkbook 

Path = "C:\Users\Admin\PMO\Test consolidation\Independent files" 
If Right$(Path, 1) <> "\" Then Path = Path & "\" 
Filename = Dir(Path & "*.xlsm") 

Dim wsname As String 
clean 

Do While Filename <> "" 
    Set wbActive = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True) 
    'Workbook_Opn_DisableMacros (Path & Filename) 

    With wbActive 
     If Evaluate("ISREF('" & "Panel" & "'!A1)") Then 'Rory 'https://stackoverflow.com/questions/6688131/test-or-check-if-sheet-exists 
      Set wsPanel = wbActive.Worksheets("Panel") 
      wsPanel.Copy After:=wbMaster.Worksheets(1) 

      If Not IsEmpty(wsPanel.Range("U5")) Then 
       ActiveSheet.Name = wsPanel.Range("U5") 
       Cells.Select 
       Range("B3").Activate 
       Selection.Copy 
       Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
       Operation:=xlNone _ 
       , SkipBlanks:=False, Transpose:=False 
       Selection.PasteSpecial Paste:=xlPasteValues, 
       Operation:=xlNone, SkipBlanks _ 
       :=False, Transpose:=False 
       Application.CutCopyMode = False 
       ActiveSheet.Visible = False 
      Else 
       MsgBox "Missing value to rename worksheet in " & Filename 
      End If 
     End If 
    End With 

    wbActive.Close 
    Filename = Dir() 
    Loop 
End Sub 

、私は明らかにこれを解決し、このコードを見つけましたが、私のファイルをクラッシュされています。

Public Sub Workbook_Opn_DisableMacros(FileComplete As String) 

Dim oldSecurity 
oldSecurity = Excel.Application.AutomationSecurity 
Excel.Application.AutomationSecurity = msoAutomationSecurityForceDisable 
Excel.Workbooks.Open (FileComplete), ReadOnly:=True 
Excel.Application.AutomationSecurity = oldSecurity 
End Sub 

誰もがこのソリューションを自分のコードにマージする方法を知っていますか?どんな援助も深く感謝しています。 ありがとう!ここ

+0

あなたがちょうどあなたのんが後にこの行を追加しようとしていますステートメント? Application.AutomationSecurity = msoAutomationSecurityForceDisable – mooseman

+0

はい。ファイルをクラッシュさせずに、データフェッチ時間を短縮しません。 – gosh

+1

ファイルを開くには時間がかかりますか?私はVBAがそのプロセスをスピードアップできることを疑う。 – mooseman

答えて

0

あなたのコード:

  Cells.Select 
      Range("B3").Activate 
      Selection.Copy 
      Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, 
      Operation:=xlNone _ 
      , SkipBlanks:=False, Transpose:=False 
      Selection.PasteSpecial Paste:=xlPasteValues, 
      Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
      Application.CutCopyMode = False 
      ActiveSheet.Visible = False 

は不要です。まず、アクティベートシートのすべてのセルを選択しています。これは数百万です。その後、1つのセルを目的に応じてアクティブにし、数百万個のセルをコピーして、値の上に貼り付けてから、もう一度やり直してからシートを非表示にします。あなたはこれをしたい理由を私は知りませんが、あなたがやって、同じ目的を達成することができます

With Activesheet 
     .usedrange.formula = .usedrange.value 
     .visible = false 
    End With 

これは、物事をスピードアップするはず

関連する問題