fork download
  1. Sub 別ブックのすべてのセルを取得()
  2.  
  3. Dim startTime As Double
  4. Dim middleTime As Double
  5. Dim processTime As Double
  6.  
  7. startTime = Timer '開始時間取得
  8.  
  9. Application.ScreenUpdating = False '画面描画を停止
  10. Application.EnableEvents = False 'イベントを抑止
  11. Application.DisplayAlerts = False '確認メッセージを抑止
  12. Application.Calculation = xlCalculationManual '計算を手動に
  13.  
  14. Dim Excel As New Application
  15.  
  16. 'エクセルを不可視で開く
  17. Excel.Visible = False 'エクセル可視/不可視設定
  18. Excel.DisplayAlerts = False '警告メッセージをオフ
  19.  
  20. Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook
  21. Dim FullPath1 As String, FullPath2 As String, FullPath3 As String, FullPath4 As String
  22.  
  23. Dim SourceRng1 As Range, SourceRng2 As Range, SourceRng3 As Range, SourceRng4 As Range
  24. Dim TargetRng1 As Range, TargetRng2 As Range, TargetRng3 As Range, TargetRng4 As Range
  25.  
  26. 'Dim AllmydataArr1 As Variant, AllmydataArr2 As Variant, AllmydataArr3 As Variant, AllmydataArr4 As Variant
  27. 'Dim AllmydataArr11 As Variant, AllmydataArr12 As Variant, AllmydataArr13 As Variant, AllmydataArr14 As Variant
  28.  
  29. '------------------------------------------------------------------------ここまで
  30. '↑ここまでは上記サンプルコードと同一↑
  31. 'メイン処理0の時間をイミディエイトウィンドウに出力
  32. middleTime = Timer
  33. processTime = middleTime - startTime
  34. Debug.Print "メイン処理0の終了:"; processTime & "秒" & vbCrLf
  35. 'Call メイン処理0の終了
  36.  
  37. Dim ws As Worksheet
  38. Dim filename As String
  39. Dim wb As Workbook
  40.  
  41.  
  42. Worksheets("kyu").Cells.Clear
  43. Worksheets("nyu").Cells.Clear
  44. Worksheets("gai").Cells.Clear
  45. Worksheets("折衝取込").Cells.Clear
  46.  
  47. ' With Worksheets(Array("kyu", "nyu", "gai", "折衝取込"))
  48. ' Cells.Clear
  49. ' End With
  50.  
  51. '貼り付け先のブック
  52. filename = ThisWorkbook.Path & "\" & "ワークシート.xlsm"
  53. Set mb = Workbooks.Open(filename)
  54. '------------------------------------------------------------------------1ここから
  55.  
  56. '開くExcelファイルを指定
  57. FullPath1 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "配信スケジュール .xlsm" ' "救急患者集計.xlsm"
  58. Set Wb1 = Excel.Workbooks.Open(FullPath1, ReadOnly:=True) '読取り専用で開く
  59. Set SourceRng1 = Wb1.Worksheets("sheet5").UsedRange
  60. ' AllmydataArr1 = SourceRng1
  61. ' AllmydataArr11 = SourceRng1.NumberFormat
  62. Set TargetRng1 = mb.Worksheets("kyu").Range("A1")
  63.  
  64. ' TargetRng1.Resize(UBound(AllmydataArr1, 1), UBound(AllmydataArr1, 2)) = AllmydataArr1
  65. ' TargetRng1.Resize(UBound(AllmydataArr1, 1), UBound(AllmydataArr1, 2)) = AllmydataArr11
  66.  
  67. SourceRng1.Copy
  68. TargetRng1.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
  69. TargetRng1.PasteSpecial Paste:=xlPasteColumnWidths
  70. Application.CutCopyMode = False
  71.  
  72. '------------------------------------------------------------------------ここまで
  73. 'メイン処理1の時間をイミディエイトウィンドウに出力
  74. middleTime = Timer
  75. processTime = middleTime - startTime
  76. Debug.Print "未納本文処理1の終了:"; processTime & "秒" & vbCrLf
  77. 'Call 未納本文処理1の終了
  78. '------------------------------------------------------------------------2ここから
  79.  
  80. '開くExcelファイルを指定
  81. FullPath2 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未納整理簿.xlsm"
  82. Set Wb2 = Excel.Workbooks.Open(FullPath2, ReadOnly:=True) '読取り専用で開く
  83. Set SourceRng2 = Wb2.Worksheets("未納本文").UsedRange
  84. Set TargetRng2 = mb.Worksheets("nyu").Range("A1")
  85.  
  86. SourceRng2.Copy
  87. TargetRng2.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
  88. TargetRng2.PasteSpecial Paste:=xlPasteColumnWidths
  89. Application.CutCopyMode = False
  90.  
  91. '------------------------------------------------------------------------ここまで
  92. 'メイン処理2の時間をイミディエイトウィンドウに出力
  93. middleTime = Timer
  94. processTime = middleTime - startTime
  95. Debug.Print "全部1処理2の終了:"; processTime & "秒" & vbCrLf
  96. 'Call 全部1処理2の終了
  97. '------------------------------------------------------------------------3ここから
  98.  
  99. '開くExcelファイルを指定
  100. FullPath3 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未納整理簿.xlsm"
  101. Set Wb3 = Excel.Workbooks.Open(FullPath3, ReadOnly:=True) '読取り専用で開く
  102. Set SourceRng3 = Wb3.Worksheets("全部1").UsedRange
  103. Set TargetRng3 = mb.Worksheets("gai").Range("A1")
  104.  
  105. SourceRng3.Copy
  106. TargetRng3.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
  107. TargetRng3.PasteSpecial Paste:=xlPasteColumnWidths
  108. Application.CutCopyMode = False
  109.  
  110. '------------------------------------------------------------------------ここまで
  111. 'メイン処理3の時間をイミディエイトウィンドウに出力
  112. middleTime = Timer
  113. processTime = middleTime - startTime
  114. Debug.Print "未納本文処理3の終了:"; processTime & "秒" & vbCrLf
  115. 'Call 未納本文処理3の終了
  116. '------------------------------------------------------------------------4ここから
  117.  
  118. '開くExcelファイルを指定
  119. FullPath4 = "C:\Users\名前\Desktop\Excelフォルダ" & "\" & "未納本文.xlsm" ' "救急患者集計.xlsm""未収金折衝状況表.xlsm"
  120. Set Wb4 = Excel.Workbooks.Open(FullPath4, ReadOnly:=True) '読取り専用で開く
  121. Set SourceRng4 = Wb4.Worksheets("未納本文").UsedRange
  122. Set TargetRng4 = mb.Worksheets("折衝取込").Range("A1")
  123.  
  124.  
  125. SourceRng4.Copy
  126. TargetRng4.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
  127. TargetRng4.PasteSpecial Paste:=xlPasteColumnWidths
  128. Application.CutCopyMode = False
  129.  
  130.  
  131. Workbooks("ワークシート.xlsm").Worksheets("sheet1").Range("A1").Copy
  132.  
  133. '------------------------------------------------------------------------ここまで
  134. 'メイン処理4の時間をイミディエイトウィンドウに出力
  135. middleTime = Timer
  136. processTime = middleTime - startTime
  137. Debug.Print "全部1をふくめた完了までの所要時間:"; processTime & "秒" & vbCrLf
  138. 'Call 全部1をふくめた完了までの所要時間
  139. '------------------------------------------------------------------------'↓ここから下は上記サンプルコードと同一↓
  140.  
  141. Application.Calculation = xlCalculationAutomatic '計算を自動に
  142. Application.DisplayAlerts = True '確認メッセージを開始
  143. Application.EnableEvents = True 'イベントを開始
  144. Application.ScreenUpdating = True
  145.  
  146.  
  147. Excel.DisplayAlerts = True '警告メッセージをオン
  148. Excel.Quit 'Excel終了
  149.  
  150. Set Excel = Nothing '参照を解放
  151. MsgBox "書き換えました"
  152. E
Not running #stdin #stdout 0s 0KB
stdin
Standard input is empty
stdout
Standard output is empty