回答編集履歴
5
追記
answer
CHANGED
|
@@ -104,34 +104,114 @@
|
|
|
104
104
|
これには非表示のシートも含まれますので、一番左のシートが非表示の場合、見えていないシートからデータを取得することになります。
|
|
105
105
|
|
|
106
106
|
以下に対象となっているシートと、セルの値を表示するサンプルを作成してみました。
|
|
107
|
+
⇒ 長くなりすぎたので全体ソースを参照してください。
|
|
108
|
+
|
|
109
|
+
これで状況を確認してみてください。
|
|
110
|
+
|
|
111
|
+
全体ソース
|
|
112
|
+
---
|
|
107
113
|
```
|
|
114
|
+
Option Explicit
|
|
115
|
+
|
|
116
|
+
Dim gyo As Long
|
|
117
|
+
Dim gyo2 As Long
|
|
118
|
+
Dim filecount As Long
|
|
119
|
+
Dim sheetcount As Long
|
|
120
|
+
Dim unmatch As Long
|
|
121
|
+
Dim erfilecount As Long
|
|
122
|
+
|
|
123
|
+
'ボタンを押したとき
|
|
124
|
+
Sub FolderSelect()
|
|
125
|
+
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
126
|
+
ThisWorkbook.Worksheets(2).Range("A3:AS3005").ClearContents
|
|
127
|
+
Dim folderpass As String
|
|
128
|
+
With Application.FileDialog(msoFileDialogFolderPicker)
|
|
129
|
+
If .Show = True Then
|
|
130
|
+
folderpass = .SelectedItems(1)
|
|
131
|
+
Else
|
|
132
|
+
ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
|
|
133
|
+
Exit Sub
|
|
134
|
+
End If
|
|
135
|
+
End With
|
|
136
|
+
|
|
137
|
+
filecount = 0
|
|
138
|
+
sheetcount = 0
|
|
139
|
+
unmatch = 0
|
|
140
|
+
erfilecount = 0
|
|
141
|
+
gyo = 6
|
|
142
|
+
gyo2 = 3
|
|
143
|
+
|
|
144
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
|
|
145
|
+
|
|
146
|
+
Call FileSearch(folderpass, "*.xls*")
|
|
147
|
+
Dim dateupdate As String
|
|
148
|
+
dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
|
|
149
|
+
ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
|
|
150
|
+
ThisWorkbook.Worksheets(2).Name = dateupdate
|
|
151
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
152
|
+
ThisWorkbook.Worksheets(2).Activate
|
|
153
|
+
End Sub
|
|
154
|
+
|
|
155
|
+
'ファイル検索
|
|
156
|
+
Sub FileSearch(Path As String, Target As String)
|
|
157
|
+
|
|
158
|
+
Dim FSO As Object, Folder As Variant, File As Variant
|
|
159
|
+
Set FSO = CreateObject("Scripting.FileSystemObject")
|
|
160
|
+
|
|
161
|
+
Dim wsStatusSheet As Worksheet '状況出力シート
|
|
162
|
+
Set wsStatusSheet = ThisWorkbook.Worksheets(1)
|
|
163
|
+
|
|
164
|
+
'全てのサブフォルダをループ処理
|
|
165
|
+
For Each Folder In FSO.GetFolder(Path).SubFolders
|
|
166
|
+
'サブフォルダを指定して再帰呼び出し
|
|
167
|
+
Call FileSearch(Folder.Path, Target)
|
|
168
|
+
Next Folder
|
|
169
|
+
|
|
170
|
+
'フォルダ内のすべてのファイルをループ処理
|
|
171
|
+
For Each File In FSO.GetFolder(Path).Files
|
|
172
|
+
If File.Name Like Target Then
|
|
173
|
+
'ファイル名がTargetに含まれる場合、処理対象
|
|
174
|
+
filecount = filecount + 1
|
|
175
|
+
wsStatusSheet.Cells(gyo, 1) = File.Name 'ファイル名を出力
|
|
176
|
+
wsStatusSheet.Cells(gyo, 2) = File.Path 'ファイルパスを出力
|
|
177
|
+
'コピー処理
|
|
178
|
+
Call ParCopy(File.Path)
|
|
179
|
+
|
|
180
|
+
gyo = gyo + 1
|
|
181
|
+
End If
|
|
182
|
+
wsStatusSheet.Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
183
|
+
Next File
|
|
184
|
+
End Sub
|
|
185
|
+
|
|
186
|
+
|
|
187
|
+
''一覧出力
|
|
108
188
|
Sub ParCopy(Path As String)
|
|
109
|
-
|
|
189
|
+
|
|
110
190
|
'Dim i As Long
|
|
111
191
|
'Dim j As Long
|
|
112
|
-
|
|
192
|
+
|
|
113
193
|
Dim openbook As Workbook
|
|
114
194
|
Dim openbooksheet As Worksheet
|
|
115
|
-
|
|
195
|
+
|
|
116
196
|
Application.ScreenUpdating = False
|
|
117
|
-
|
|
197
|
+
|
|
118
198
|
On Error GoTo myError
|
|
119
199
|
Set openbook = Application.Workbooks.Open(Path)
|
|
120
|
-
|
|
200
|
+
|
|
121
201
|
'一覧化コピペ
|
|
122
202
|
'For i = 1 To openbook.Worksheets.Count
|
|
123
|
-
|
|
203
|
+
|
|
124
204
|
Set openbooksheet = openbook.Worksheets(1)
|
|
125
|
-
|
|
205
|
+
|
|
126
206
|
'Dim blof As Variant
|
|
127
207
|
'ReDim blofar(0 To 1)
|
|
128
208
|
'For j = 0 To UBound(blof)
|
|
129
209
|
' blofar(j) = Trim(blof(j))
|
|
130
210
|
'Next j
|
|
131
|
-
|
|
211
|
+
|
|
132
212
|
Dim strMsg As String 'デバッグ用メッセージ
|
|
133
213
|
strMsg = ""
|
|
134
|
-
|
|
214
|
+
|
|
135
215
|
If openbooksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row <> 1 Then
|
|
136
216
|
'シートに書き出し
|
|
137
217
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 6) = openbooksheet.Range("A70")
|
|
@@ -146,7 +226,7 @@
|
|
|
146
226
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 52) = openbooksheet.Range("M22")
|
|
147
227
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 54) = openbooksheet.Range("T22")
|
|
148
228
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 56) = openbooksheet.Range("M22")
|
|
149
|
-
|
|
229
|
+
|
|
150
230
|
'デバッグ用メッセージに書き出し
|
|
151
231
|
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
152
232
|
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
@@ -160,17 +240,17 @@
|
|
|
160
240
|
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
161
241
|
strMsg = strMsg & "T22 :" & openbooksheet.Range("T22") & vbCr
|
|
162
242
|
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
163
|
-
|
|
243
|
+
|
|
164
244
|
gyo2 = gyo2 + 1
|
|
165
245
|
End If
|
|
166
|
-
|
|
246
|
+
|
|
167
247
|
'処理中のファイル名・シート名を画面表示する
|
|
168
|
-
|
|
248
|
+
MsgBox "ファイル名：" & Path & vbCr & "シート名：" & openbooksheet.Name & vbCr & strMsg
|
|
169
|
-
|
|
249
|
+
|
|
170
250
|
'Next i
|
|
171
|
-
|
|
251
|
+
|
|
172
252
|
openbook.Close False
|
|
173
|
-
|
|
253
|
+
|
|
174
254
|
Application.ScreenUpdating = True
|
|
175
255
|
Exit Sub
|
|
176
256
|
myError:
|
|
@@ -180,4 +260,4 @@
|
|
|
180
260
|
End Sub
|
|
181
261
|
```
|
|
182
262
|
|
|
183
|
-
こ
|
|
263
|
+
このコードで、指定フォルダ配下の２ファイル、およびそのサブフォルダ配下の１ファイルからの情報取得を確認しています。
|
4
追記
answer
CHANGED
|
@@ -6,6 +6,9 @@
|
|
|
6
6
|
|
|
7
7
|
解析したところ、指定されたフォルダ配下（サブフォルダ含む）のExcelファイルを検索し、各シートの特定セルの内容を自ブックのシート２に書き出すVBAマクロだと思われます。
|
|
8
8
|
|
|
9
|
+
|
|
10
|
+
気になったこと
|
|
11
|
+
---
|
|
9
12
|
ソース上、気になる点がいくつかありました。
|
|
10
13
|
①全シート数分のループ処理をしているのに、読み込みシートは常にシート１でよいのか？
|
|
11
14
|
```
|
|
@@ -79,6 +82,8 @@
|
|
|
79
82
|
といった調査で原因を特定していけばよいと思います。
|
|
80
83
|
|
|
81
84
|
---
|
|
85
|
+
|
|
86
|
+
|
|
82
87
|
追記を受けて
|
|
83
88
|
---
|
|
84
89
|
やりたいことはおおよそ伝わりましたが、エラーの発生状況がまだよくわかりません。
|
3
追記
answer
CHANGED
|
@@ -76,4 +76,103 @@
|
|
|
76
76
|
⇒入力元のデータの問題か、繰り返し処理による問題かの判別
|
|
77
77
|
・ParCopy関数内にブレイクポイントを貼って、問題のファイルを読み込むあたりを重点的にデバッグする
|
|
78
78
|
⇒具体的に空セルがセットされるメカニズムを把握する
|
|
79
|
-
といった調査で原因を特定していけばよいと思います。
|
|
79
|
+
といった調査で原因を特定していけばよいと思います。
|
|
80
|
+
|
|
81
|
+
---
|
|
82
|
+
追記を受けて
|
|
83
|
+
---
|
|
84
|
+
やりたいことはおおよそ伝わりましたが、エラーの発生状況がまだよくわかりません。
|
|
85
|
+
|
|
86
|
+
コードが期待通りのロジックとなっているのなら、取り込まれる側シートのA70,R2,…AE48の内容を取り込む側シートの6,7,42,…56列目にコピーしたいのだと思います。
|
|
87
|
+
・これらすべてが空欄となるのか
|
|
88
|
+
・あるファイルの分はコピーできているが、あるファイルの分は空欄となってしまうのか
|
|
89
|
+
|
|
90
|
+
|
|
91
|
+
追加で気になったこと
|
|
92
|
+
---
|
|
93
|
+
コード内で読み取るシートを
|
|
94
|
+
```
|
|
95
|
+
Set openbooksheet = openbook.Worksheets(1)
|
|
96
|
+
```
|
|
97
|
+
と指定しています。
|
|
98
|
+
これで取得できるシートは、ブック内で一番左側のシートです。
|
|
99
|
+
これには非表示のシートも含まれますので、一番左のシートが非表示の場合、見えていないシートからデータを取得することになります。
|
|
100
|
+
|
|
101
|
+
以下に対象となっているシートと、セルの値を表示するサンプルを作成してみました。
|
|
102
|
+
```
|
|
103
|
+
Sub ParCopy(Path As String)
|
|
104
|
+
|
|
105
|
+
'Dim i As Long
|
|
106
|
+
'Dim j As Long
|
|
107
|
+
|
|
108
|
+
Dim openbook As Workbook
|
|
109
|
+
Dim openbooksheet As Worksheet
|
|
110
|
+
|
|
111
|
+
Application.ScreenUpdating = False
|
|
112
|
+
|
|
113
|
+
On Error GoTo myError
|
|
114
|
+
Set openbook = Application.Workbooks.Open(Path)
|
|
115
|
+
|
|
116
|
+
'一覧化コピペ
|
|
117
|
+
'For i = 1 To openbook.Worksheets.Count
|
|
118
|
+
|
|
119
|
+
Set openbooksheet = openbook.Worksheets(1)
|
|
120
|
+
|
|
121
|
+
'Dim blof As Variant
|
|
122
|
+
'ReDim blofar(0 To 1)
|
|
123
|
+
'For j = 0 To UBound(blof)
|
|
124
|
+
' blofar(j) = Trim(blof(j))
|
|
125
|
+
'Next j
|
|
126
|
+
|
|
127
|
+
Dim strMsg As String 'デバッグ用メッセージ
|
|
128
|
+
strMsg = ""
|
|
129
|
+
|
|
130
|
+
If openbooksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row <> 1 Then
|
|
131
|
+
'シートに書き出し
|
|
132
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 6) = openbooksheet.Range("A70")
|
|
133
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 7) = openbooksheet.Range("A70")
|
|
134
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 42) = openbooksheet.Range("R2")
|
|
135
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 43) = openbooksheet.Range("AC43")
|
|
136
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 44) = openbooksheet.Range("AC44")
|
|
137
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 45) = openbooksheet.Range("AC45")
|
|
138
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 46) = openbooksheet.Range("AC46")
|
|
139
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 47) = openbooksheet.Range("AE48")
|
|
140
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 49) = openbooksheet.Range("AA2")
|
|
141
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 52) = openbooksheet.Range("M22")
|
|
142
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 54) = openbooksheet.Range("T22")
|
|
143
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 56) = openbooksheet.Range("M22")
|
|
144
|
+
|
|
145
|
+
'デバッグ用メッセージに書き出し
|
|
146
|
+
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
147
|
+
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
148
|
+
strMsg = strMsg & "R2 :" & openbooksheet.Range("R2") & vbCr
|
|
149
|
+
strMsg = strMsg & "AC43:" & openbooksheet.Range("AC43") & vbCr
|
|
150
|
+
strMsg = strMsg & "AC44:" & openbooksheet.Range("AC44") & vbCr
|
|
151
|
+
strMsg = strMsg & "AC45:" & openbooksheet.Range("AC45") & vbCr
|
|
152
|
+
strMsg = strMsg & "AC46:" & openbooksheet.Range("AC46") & vbCr
|
|
153
|
+
strMsg = strMsg & "AE48:" & openbooksheet.Range("AE48") & vbCr
|
|
154
|
+
strMsg = strMsg & "AA2 :" & openbooksheet.Range("AA2") & vbCr
|
|
155
|
+
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
156
|
+
strMsg = strMsg & "T22 :" & openbooksheet.Range("T22") & vbCr
|
|
157
|
+
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
158
|
+
|
|
159
|
+
gyo2 = gyo2 + 1
|
|
160
|
+
End If
|
|
161
|
+
|
|
162
|
+
'処理中のファイル名・シート名を画面表示する
|
|
163
|
+
Msgbox "ファイル名：" & Path & vbCr & "シート名：" & openbooksheet.Name & vbCr & strMsg
|
|
164
|
+
|
|
165
|
+
'Next i
|
|
166
|
+
|
|
167
|
+
openbook.Close False
|
|
168
|
+
|
|
169
|
+
Application.ScreenUpdating = True
|
|
170
|
+
Exit Sub
|
|
171
|
+
myError:
|
|
172
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
|
|
173
|
+
erfilecount = erfilecount + 1
|
|
174
|
+
Application.ScreenUpdating = True
|
|
175
|
+
End Sub
|
|
176
|
+
```
|
|
177
|
+
|
|
178
|
+
これで状況を確認してみてください。
|
2
修正
answer
CHANGED
|
@@ -1,4 +1,4 @@
|
|
|
1
|
-
どんなデータを読みとった時にどんな動作を
|
|
1
|
+
どんなデータを読みとった時にどんな動作をするのか、
|
|
2
2
|
・期待する動作
|
|
3
3
|
・実際の動作
|
|
4
4
|
・対象フォルダの構成
|
1
修正
answer
CHANGED
|
@@ -1,7 +1,8 @@
|
|
|
1
|
+
どんなデータを読みとった時にどんな動作をしているのか、
|
|
1
2
|
・期待する動作
|
|
2
3
|
・実際の動作
|
|
3
4
|
・対象フォルダの構成
|
|
4
|
-
|
|
5
|
+
が不明瞭なので的確なアドバイスができているかわかりませんが。
|
|
5
6
|
|
|
6
7
|
解析したところ、指定されたフォルダ配下（サブフォルダ含む）のExcelファイルを検索し、各シートの特定セルの内容を自ブックのシート２に書き出すVBAマクロだと思われます。
|
|
7
8
|
|
|
@@ -12,7 +13,7 @@
|
|
|
12
13
|
```
|
|
13
14
|
|
|
14
15
|
|
|
15
|
-
②配列でない変数を配列として扱っている為エラーが発生している
|
|
16
|
+
②配列でない変数を配列として扱っている為エラーが発生している ⇒不要な処理であれば削除する
|
|
16
17
|
```
|
|
17
18
|
|
|
18
19
|
Dim blof As Variant
|