回答編集履歴

2

コードの追加

2018/05/11 14:45

投稿

hatena19
hatena19

スコア34064

test CHANGED
@@ -117,3 +117,75 @@
117
117
  まずは、私のコードは、元のコードとほぼと同じなので意味はすぐ理解できると思います。
118
118
 
119
119
  それを理解した上で、imihitoさんのコードを、私との違いを意識しながら、読むと理解が捗ると思います。
120
+
121
+
122
+
123
+ **上記のコードの改良版**
124
+
125
+ ```
126
+
127
+ Sub 取り込みテスト()
128
+
129
+ Dim myPath As String
130
+
131
+ Dim myFile As String
132
+
133
+ Dim FromBook As Workbook '集計元ブック
134
+
135
+ Dim ToSheet As Worksheet '集計先シート
136
+
137
+ Dim CurRow As Long '入力する行インデックス
138
+
139
+ Dim i As Long
140
+
141
+
142
+
143
+ Set ToSheet = ThisWorkbook.Worksheets("Sheet1") '
144
+
145
+ myPath = ThisWorkbook.Path & "\"
146
+
147
+ myFile = Dir(myPath & "*.xlsx")
148
+
149
+
150
+
151
+ Application.ScreenUpdating = False '画面更新の抑制
152
+
153
+
154
+
155
+ CurRow = 1
156
+
157
+ Do Until myFile = ""
158
+
159
+ Set FromBook = Workbooks.Open(myPath & "\" & myFile) '開いたブックを変数にセット
160
+
161
+ For i = 1 To FromBook.Worksheets.Count
162
+
163
+ With FromBook.Worksheets(i)
164
+
165
+ ToSheet.Cells(CurRow, 1).Value = myFile & "!" & .Name
166
+
167
+ ToSheet.Cells(CurRow, 2).Value = .Range("A2").Value
168
+
169
+ ToSheet.Cells(CurRow, 3).Value = .Range("D2").Value
170
+
171
+ End With
172
+
173
+ CurRow = CurRow + 1 '次の行に移動
174
+
175
+ Next i
176
+
177
+ FromBook.Close '集計元ブックを閉じる
178
+
179
+ myFile = Dir()
180
+
181
+ Loop
182
+
183
+ Application.ScreenUpdating = True
184
+
185
+
186
+
187
+ MsgBox "取り込み完了しました。"
188
+
189
+ End Sub
190
+
191
+ ```

1

追記

2018/05/11 14:45

投稿

hatena19
hatena19

スコア34064

test CHANGED
@@ -105,3 +105,15 @@
105
105
  Application.ScreenUpdating を使って画面更新を抑止するとチラツキを抑制できます。
106
106
 
107
107
  Copy PasteSpecial を使わなくても、代入という処理で値を入力できます。
108
+
109
+
110
+
111
+ 追記
112
+
113
+ ---
114
+
115
+ タッチの差で、imihitoさんに先を越されました。しかも、より完成度の高いコードです。
116
+
117
+ まずは、私のコードは、元のコードとほぼと同じなので意味はすぐ理解できると思います。
118
+
119
+ それを理解した上で、imihitoさんのコードを、私との違いを意識しながら、読むと理解が捗ると思います。