回答編集履歴
2
コードの追加
answer
CHANGED
|
@@ -57,4 +57,40 @@
|
|
|
57
57
|
---
|
|
58
58
|
タッチの差で、imihitoさんに先を越されました。しかも、より完成度の高いコードです。
|
|
59
59
|
まずは、私のコードは、元のコードとほぼと同じなので意味はすぐ理解できると思います。
|
|
60
|
-
それを理解した上で、imihitoさんのコードを、私との違いを意識しながら、読むと理解が捗ると思います。
|
|
60
|
+
それを理解した上で、imihitoさんのコードを、私との違いを意識しながら、読むと理解が捗ると思います。
|
|
61
|
+
|
|
62
|
+
**上記のコードの改良版**
|
|
63
|
+
```
|
|
64
|
+
Sub 取り込みテスト()
|
|
65
|
+
Dim myPath As String
|
|
66
|
+
Dim myFile As String
|
|
67
|
+
Dim FromBook As Workbook '集計元ブック
|
|
68
|
+
Dim ToSheet As Worksheet '集計先シート
|
|
69
|
+
Dim CurRow As Long '入力する行インデックス
|
|
70
|
+
Dim i As Long
|
|
71
|
+
|
|
72
|
+
Set ToSheet = ThisWorkbook.Worksheets("Sheet1") '
|
|
73
|
+
myPath = ThisWorkbook.Path & "\"
|
|
74
|
+
myFile = Dir(myPath & "*.xlsx")
|
|
75
|
+
|
|
76
|
+
Application.ScreenUpdating = False '画面更新の抑制
|
|
77
|
+
|
|
78
|
+
CurRow = 1
|
|
79
|
+
Do Until myFile = ""
|
|
80
|
+
Set FromBook = Workbooks.Open(myPath & "\" & myFile) '開いたブックを変数にセット
|
|
81
|
+
For i = 1 To FromBook.Worksheets.Count
|
|
82
|
+
With FromBook.Worksheets(i)
|
|
83
|
+
ToSheet.Cells(CurRow, 1).Value = myFile & "!" & .Name
|
|
84
|
+
ToSheet.Cells(CurRow, 2).Value = .Range("A2").Value
|
|
85
|
+
ToSheet.Cells(CurRow, 3).Value = .Range("D2").Value
|
|
86
|
+
End With
|
|
87
|
+
CurRow = CurRow + 1 '次の行に移動
|
|
88
|
+
Next i
|
|
89
|
+
FromBook.Close '集計元ブックを閉じる
|
|
90
|
+
myFile = Dir()
|
|
91
|
+
Loop
|
|
92
|
+
Application.ScreenUpdating = True
|
|
93
|
+
|
|
94
|
+
MsgBox "取り込み完了しました。"
|
|
95
|
+
End Sub
|
|
96
|
+
```
|
1
追記
answer
CHANGED
|
@@ -51,4 +51,10 @@
|
|
|
51
51
|
この辺りは完全の余地が大です。
|
|
52
52
|
ヒントを出しておきますと、
|
|
53
53
|
Application.ScreenUpdating を使って画面更新を抑止するとチラツキを抑制できます。
|
|
54
|
-
Copy PasteSpecial を使わなくても、代入という処理で値を入力できます。
|
|
54
|
+
Copy PasteSpecial を使わなくても、代入という処理で値を入力できます。
|
|
55
|
+
|
|
56
|
+
追記
|
|
57
|
+
---
|
|
58
|
+
タッチの差で、imihitoさんに先を越されました。しかも、より完成度の高いコードです。
|
|
59
|
+
まずは、私のコードは、元のコードとほぼと同じなので意味はすぐ理解できると思います。
|
|
60
|
+
それを理解した上で、imihitoさんのコードを、私との違いを意識しながら、読むと理解が捗ると思います。
|