質問編集履歴
15
追記
title
CHANGED
|
@@ -1,1 +1,1 @@
|
|
|
1
|
-
Excel.マクロ.VBお助けください。
|
|
1
|
+
つExcel.マクロ.VBお助けください。
|
body
CHANGED
|
@@ -132,11 +132,90 @@
|
|
|
132
132
|
1-45(A-AS)は空白に書き換わり
|
|
133
133
|
46-57(AT-BE)は値が入ったままになっています。
|
|
134
134
|
追記３
|
|
135
|
+
|
|
136
|
+
このようなメッセージが出ました。
|
|
137
|
+
隠れていたシートがありそこを指定していた間違いを修正しました。
|
|
138
|
+
ですが、追記２の部分が未だに謎のままです。
|
|
139
|
+
あと少しお力添えをお願いします。
|
|
140
|
+
|
|
141
|
+
|
|
142
|
+
|
|
143
|
+
|
|
144
|
+
追記４
|
|
145
|
+
マクロを起動すると取り込まれる側のエクセルデータが立ち上がるのですが自動的に消える処理まで到達していないことが分かりました。相変わらずデータの取得はできていません。原因解明の手口となればよいのですが…調べても原因解明に至っておりません。言葉足らずで頼ってばかりで申し訳ありませんがよろしくお願いします。
|
|
146
|
+
|
|
147
|
+
追記５
|
|
148
|
+
|
|
149
|
+
ttyp03さん用
|
|
150
|
+
|
|
151
|
+
お礼
|
|
152
|
+
|
|
153
|
+
皆さまのお力添えあって解決することができました！！！
|
|
154
|
+
ベストアンサーをお二方で悩みましたが
|
|
155
|
+
jawaさんとさせていただきます。
|
|
156
|
+
ttypさん、jawaさん本当にありがとうございました。
|
|
157
|
+
|
|
135
158
|
```
|
|
159
|
+
Option Explicit
|
|
160
|
+
|
|
161
|
+
Dim gyo As Long
|
|
162
|
+
Dim gyo2 As Long
|
|
163
|
+
Dim filecount As Long
|
|
164
|
+
Dim sheetcount As Long
|
|
165
|
+
Dim unmatch As Long
|
|
166
|
+
Dim erfilecount As Long
|
|
167
|
+
'ボタンを押したとき
|
|
168
|
+
Sub FolderSelect()
|
|
169
|
+
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
170
|
+
ThisWorkbook.Worksheets(2).Range("A3:BE3005").ClearContents
|
|
171
|
+
Dim folderpass As String
|
|
172
|
+
With Application.FileDialog(msoFileDialogFolderPicker)
|
|
173
|
+
If .Show = True Then
|
|
174
|
+
folderpass = .SelectedItems(1)
|
|
175
|
+
Else
|
|
176
|
+
ThisWorkbook.Worksheets(1).Range("B3").Value = "キャンセルしました。"
|
|
177
|
+
Exit Sub
|
|
178
|
+
End If
|
|
179
|
+
End With
|
|
180
|
+
|
|
181
|
+
filecount = 0
|
|
182
|
+
sheetcount = 0
|
|
183
|
+
unmatch = 0
|
|
184
|
+
erfilecount = 0
|
|
185
|
+
gyo = 6
|
|
186
|
+
gyo2 = 3
|
|
187
|
+
|
|
188
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "処理中"
|
|
189
|
+
|
|
190
|
+
Call FileSearch(folderpass, "*.xls*")
|
|
191
|
+
Dim dateupdate As String
|
|
192
|
+
dateupdate = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日更新"
|
|
193
|
+
ThisWorkbook.Worksheets(2).Range("A1").Value = dateupdate
|
|
194
|
+
ThisWorkbook.Worksheets(2).Name = dateupdate
|
|
195
|
+
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
196
|
+
ThisWorkbook.Worksheets(2).Activate
|
|
197
|
+
End Sub
|
|
198
|
+
'ファイル検索
|
|
199
|
+
Sub FileSearch(Path As String, Target As String)
|
|
200
|
+
Dim FSO As Object, Folder As Variant, File As Variant
|
|
201
|
+
Set FSO = CreateObject("Scripting.FileSystemObject")
|
|
202
|
+
For Each Folder In FSO.GetFolder(Path).SubFolders
|
|
203
|
+
Call FileSearch(Folder.Path, Target)
|
|
204
|
+
Next Folder
|
|
205
|
+
For Each File In FSO.GetFolder(Path).Files
|
|
206
|
+
If File.Name Like Target Then
|
|
207
|
+
filecount = filecount + 1
|
|
208
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 1) = File.Name
|
|
209
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 2) = File.Path
|
|
210
|
+
Call ParCopy(File.Path)
|
|
211
|
+
gyo = gyo + 1
|
|
212
|
+
End If
|
|
213
|
+
ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
214
|
+
Next File
|
|
215
|
+
End Sub
|
|
216
|
+
''一覧出力
|
|
136
217
|
Sub ParCopy(Path As String)
|
|
137
218
|
|
|
138
|
-
'Dim i As Long
|
|
139
|
-
'Dim j As Long
|
|
140
219
|
|
|
141
220
|
Dim openbook As Workbook
|
|
142
221
|
Dim openbooksheet As Worksheet
|
|
@@ -146,16 +225,12 @@
|
|
|
146
225
|
On Error GoTo myError
|
|
147
226
|
Set openbook = Application.Workbooks.Open(Path)
|
|
148
227
|
|
|
149
|
-
'一覧化コピペ
|
|
150
|
-
'For i = 1 To openbook.Worksheets.Count
|
|
151
228
|
|
|
229
|
+
|
|
152
230
|
Set openbooksheet = openbook.Worksheets(1)
|
|
231
|
+
openbooksheet.Unprotect
|
|
232
|
+
|
|
153
233
|
|
|
154
|
-
'Dim blof As Variant
|
|
155
|
-
'ReDim blofar(0 To 1)
|
|
156
|
-
'For j = 0 To UBound(blof)
|
|
157
|
-
' blofar(j) = Trim(blof(j))
|
|
158
|
-
'Next j
|
|
159
234
|
|
|
160
235
|
Dim strMsg As String 'デバッグ用メッセージ
|
|
161
236
|
strMsg = ""
|
|
@@ -175,57 +250,24 @@
|
|
|
175
250
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 54) = openbooksheet.Range("T22")
|
|
176
251
|
ThisWorkbook.Worksheets(2).Cells(gyo2, 56) = openbooksheet.Range("M22")
|
|
177
252
|
|
|
178
|
-
|
|
253
|
+
|
|
179
|
-
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
180
|
-
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
181
|
-
strMsg = strMsg & "R2 :" & openbooksheet.Range("R2") & vbCr
|
|
182
|
-
strMsg = strMsg & "AC43:" & openbooksheet.Range("AC43") & vbCr
|
|
183
|
-
strMsg = strMsg & "AC44:" & openbooksheet.Range("AC44") & vbCr
|
|
184
|
-
strMsg = strMsg & "AC45:" & openbooksheet.Range("AC45") & vbCr
|
|
185
|
-
strMsg = strMsg & "AC46:" & openbooksheet.Range("AC46") & vbCr
|
|
186
|
-
strMsg = strMsg & "AE48:" & openbooksheet.Range("AE48") & vbCr
|
|
187
|
-
strMsg = strMsg & "AA2 :" & openbooksheet.Range("AA2") & vbCr
|
|
188
|
-
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
189
|
-
strMsg = strMsg & "T22 :" & openbooksheet.Range("T22") & vbCr
|
|
190
|
-
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
191
|
-
|
|
192
254
|
gyo2 = gyo2 + 1
|
|
193
255
|
End If
|
|
194
256
|
|
|
195
|
-
|
|
257
|
+
|
|
196
|
-
|
|
258
|
+
MsgBox "ファイル名：" & Path & vbCr & "シート名：" & openbooksheet.Name & vbCr & strMsg
|
|
197
259
|
|
|
198
|
-
|
|
260
|
+
|
|
199
|
-
|
|
200
261
|
openbook.Close False
|
|
201
262
|
|
|
202
263
|
Application.ScreenUpdating = True
|
|
203
264
|
Exit Sub
|
|
204
265
|
myError:
|
|
266
|
+
MsgBox Err.Description
|
|
205
267
|
ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
|
|
206
268
|
erfilecount = erfilecount + 1
|
|
207
269
|
Application.ScreenUpdating = True
|
|
208
270
|
End Sub
|
|
209
271
|
```
|
|
210
|
-
このソースを使用して起動すると
|
|
211
|
-
|
|
272
|
+
同じような躓き方をする方がいましたら使ってください。
|
|
212
|
-
隠れていたシートがありそこを指定していた間違いを修正しました。
|
|
213
|
-
ですが、追記２の部分が未だに謎のままです。
|
|
214
|
-
|
|
273
|
+
現在動いている最終形態です。
|
|
215
|
-
|
|
216
|
-
|
|
217
|
-
|
|
218
|
-
|
|
219
|
-
追記４
|
|
220
|
-
マクロを起動すると取り込まれる側のエクセルデータが立ち上がるのですが自動的に消える処理まで到達していないことが分かりました。相変わらずデータの取得はできていません。原因解明の手口となればよいのですが…調べても原因解明に至っておりません。言葉足らずで頼ってばかりで申し訳ありませんがよろしくお願いします。
|
|
221
|
-
|
|
222
|
-
追記５
|
|
223
|
-
|
|
224
|
-
ttyp03さん用
|
|
225
|
-
|
|
226
|
-
お礼
|
|
227
|
-
|
|
228
|
-
皆さまのお力添えあって解決することができました！！！
|
|
229
|
-
ベストアンサーをお二方で悩みましたが
|
|
230
|
-
jawaさんとさせていただきます。
|
|
231
|
-
ttypさん、jawaさん本当にありがとうございました。
|
14
お礼
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -221,4 +221,11 @@
|
|
|
221
221
|
|
|
222
222
|
追記５
|
|
223
223
|
|
|
224
|
-
ttyp03さん用
|
|
224
|
+
ttyp03さん用
|
|
225
|
+
|
|
226
|
+
お礼
|
|
227
|
+
|
|
228
|
+
皆さまのお力添えあって解決することができました！！！
|
|
229
|
+
ベストアンサーをお二方で悩みましたが
|
|
230
|
+
jawaさんとさせていただきます。
|
|
231
|
+
ttypさん、jawaさん本当にありがとうございました。
|
13
追記5
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -217,4 +217,8 @@
|
|
|
217
217
|
|
|
218
218
|
|
|
219
219
|
追記４
|
|
220
|
-
マクロを起動すると取り込まれる側のエクセルデータが立ち上がるのですが自動的に消える処理まで到達していないことが分かりました。相変わらずデータの取得はできていません。原因解明の手口となればよいのですが…調べても原因解明に至っておりません。言葉足らずで頼ってばかりで申し訳ありませんがよろしくお願いします。
|
|
220
|
+
マクロを起動すると取り込まれる側のエクセルデータが立ち上がるのですが自動的に消える処理まで到達していないことが分かりました。相変わらずデータの取得はできていません。原因解明の手口となればよいのですが…調べても原因解明に至っておりません。言葉足らずで頼ってばかりで申し訳ありませんがよろしくお願いします。
|
|
221
|
+
|
|
222
|
+
追記５
|
|
223
|
+
|
|
224
|
+
ttyp03さん用
|
12
追記４
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -214,4 +214,7 @@
|
|
|
214
214
|
あと少しお力添えをお願いします。
|
|
215
215
|
|
|
216
216
|
|
|
217
|
-
|
|
217
|
+
|
|
218
|
+
|
|
219
|
+
追記４
|
|
220
|
+
マクロを起動すると取り込まれる側のエクセルデータが立ち上がるのですが自動的に消える処理まで到達していないことが分かりました。相変わらずデータの取得はできていません。原因解明の手口となればよいのですが…調べても原因解明に至っておりません。言葉足らずで頼ってばかりで申し訳ありませんがよろしくお願いします。
|
11
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -126,11 +126,12 @@
|
|
|
126
126
|
複数個のデータ（1シート目に取り込みたいデータがある）が入ったフォルダ（取り込まれる側）を選択し、取り込む側の2シート目に出力すというマクロです。
|
|
127
127
|
取り込む側のシート構成は１シート目に取り込んだデータのタイトルが並ぶ役割を、2シート目には指定したデータを集計する欄を作ってあります。
|
|
128
128
|
1シート目のタイトルは出てくるのですが、2シート目の集計シートに指定したセルのデータがなぜか入らないという状況です。よろしくお願いします。
|
|
129
|
-
追記
|
|
129
|
+
追記２
|
|
130
130
|
どこまでデータが上書きされるのか確認するために
|
|
131
131
|
1-57(A-BE)に適当な値を入れてマクロを起動すると
|
|
132
132
|
1-45(A-AS)は空白に書き換わり
|
|
133
133
|
46-57(AT-BE)は値が入ったままになっています。
|
|
134
|
+
追記３
|
|
134
135
|
```
|
|
135
136
|
Sub ParCopy(Path As String)
|
|
136
137
|
|
|
@@ -208,4 +209,9 @@
|
|
|
208
209
|
```
|
|
209
210
|
このソースを使用して起動すると
|
|
210
211
|
このようなメッセージが出ました。
|
|
212
|
+
隠れていたシートがありそこを指定していた間違いを修正しました。
|
|
213
|
+
ですが、追記２の部分が未だに謎のままです。
|
|
214
|
+
あと少しお力添えをお願いします。
|
|
215
|
+
|
|
216
|
+
|
|
211
217
|
|
10
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -131,4 +131,81 @@
|
|
|
131
131
|
1-57(A-BE)に適当な値を入れてマクロを起動すると
|
|
132
132
|
1-45(A-AS)は空白に書き換わり
|
|
133
133
|
46-57(AT-BE)は値が入ったままになっています。
|
|
134
|
+
```
|
|
135
|
+
Sub ParCopy(Path As String)
|
|
136
|
+
|
|
137
|
+
'Dim i As Long
|
|
138
|
+
'Dim j As Long
|
|
139
|
+
|
|
140
|
+
Dim openbook As Workbook
|
|
141
|
+
Dim openbooksheet As Worksheet
|
|
142
|
+
|
|
143
|
+
Application.ScreenUpdating = False
|
|
144
|
+
|
|
145
|
+
On Error GoTo myError
|
|
146
|
+
Set openbook = Application.Workbooks.Open(Path)
|
|
147
|
+
|
|
148
|
+
'一覧化コピペ
|
|
149
|
+
'For i = 1 To openbook.Worksheets.Count
|
|
150
|
+
|
|
151
|
+
Set openbooksheet = openbook.Worksheets(1)
|
|
152
|
+
|
|
153
|
+
'Dim blof As Variant
|
|
154
|
+
'ReDim blofar(0 To 1)
|
|
155
|
+
'For j = 0 To UBound(blof)
|
|
156
|
+
' blofar(j) = Trim(blof(j))
|
|
157
|
+
'Next j
|
|
158
|
+
|
|
159
|
+
Dim strMsg As String 'デバッグ用メッセージ
|
|
160
|
+
strMsg = ""
|
|
161
|
+
|
|
162
|
+
If openbooksheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row <> 1 Then
|
|
163
|
+
'シートに書き出し
|
|
164
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 6) = openbooksheet.Range("A70")
|
|
165
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 7) = openbooksheet.Range("A70")
|
|
166
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 42) = openbooksheet.Range("R2")
|
|
167
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 43) = openbooksheet.Range("AC43")
|
|
168
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 44) = openbooksheet.Range("AC44")
|
|
169
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 45) = openbooksheet.Range("AC45")
|
|
170
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 46) = openbooksheet.Range("AC46")
|
|
171
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 47) = openbooksheet.Range("AE48")
|
|
172
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 49) = openbooksheet.Range("AA2")
|
|
173
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 52) = openbooksheet.Range("M22")
|
|
174
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 54) = openbooksheet.Range("T22")
|
|
175
|
+
ThisWorkbook.Worksheets(2).Cells(gyo2, 56) = openbooksheet.Range("M22")
|
|
176
|
+
|
|
177
|
+
'デバッグ用メッセージに書き出し
|
|
178
|
+
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
179
|
+
strMsg = strMsg & "A70 :" & openbooksheet.Range("A70") & vbCr
|
|
180
|
+
strMsg = strMsg & "R2 :" & openbooksheet.Range("R2") & vbCr
|
|
181
|
+
strMsg = strMsg & "AC43:" & openbooksheet.Range("AC43") & vbCr
|
|
182
|
+
strMsg = strMsg & "AC44:" & openbooksheet.Range("AC44") & vbCr
|
|
183
|
+
strMsg = strMsg & "AC45:" & openbooksheet.Range("AC45") & vbCr
|
|
184
|
+
strMsg = strMsg & "AC46:" & openbooksheet.Range("AC46") & vbCr
|
|
185
|
+
strMsg = strMsg & "AE48:" & openbooksheet.Range("AE48") & vbCr
|
|
186
|
+
strMsg = strMsg & "AA2 :" & openbooksheet.Range("AA2") & vbCr
|
|
187
|
+
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
188
|
+
strMsg = strMsg & "T22 :" & openbooksheet.Range("T22") & vbCr
|
|
189
|
+
strMsg = strMsg & "M22 :" & openbooksheet.Range("M22") & vbCr
|
|
190
|
+
|
|
191
|
+
gyo2 = gyo2 + 1
|
|
192
|
+
End If
|
|
193
|
+
|
|
194
|
+
'処理中のファイル名・シート名を画面表示する
|
|
195
|
+
Msgbox "ファイル名：" & Path & vbCr & "シート名：" & openbooksheet.Name & vbCr & strMsg
|
|
196
|
+
|
|
197
|
+
'Next i
|
|
198
|
+
|
|
199
|
+
openbook.Close False
|
|
200
|
+
|
|
201
|
+
Application.ScreenUpdating = True
|
|
202
|
+
Exit Sub
|
|
203
|
+
myError:
|
|
204
|
+
ThisWorkbook.Worksheets(1).Cells(gyo, 3) = "エラー発生"
|
|
205
|
+
erfilecount = erfilecount + 1
|
|
206
|
+
Application.ScreenUpdating = True
|
|
207
|
+
End Sub
|
|
208
|
+
```
|
|
209
|
+
このソースを使用して起動すると
|
|
210
|
+
このようなメッセージが出ました。
|
|
134
211
|
|
9
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -130,4 +130,5 @@
|
|
|
130
130
|
どこまでデータが上書きされるのか確認するために
|
|
131
131
|
1-57(A-BE)に適当な値を入れてマクロを起動すると
|
|
132
132
|
1-45(A-AS)は空白に書き換わり
|
|
133
|
-
46-57(AT-BE)は値が入ったままになっています。
|
|
133
|
+
46-57(AT-BE)は値が入ったままになっています。
|
|
134
|
+
|
8
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -125,4 +125,9 @@
|
|
|
125
125
|
あまりにも言葉足らずでしたので追記します。
|
|
126
126
|
複数個のデータ（1シート目に取り込みたいデータがある）が入ったフォルダ（取り込まれる側）を選択し、取り込む側の2シート目に出力すというマクロです。
|
|
127
127
|
取り込む側のシート構成は１シート目に取り込んだデータのタイトルが並ぶ役割を、2シート目には指定したデータを集計する欄を作ってあります。
|
|
128
|
-
1シート目のタイトルは出てくるのですが、2シート目の集計シートに指定したセルのデータがなぜか入らないという状況です。よろしくお願いします。
|
|
128
|
+
1シート目のタイトルは出てくるのですが、2シート目の集計シートに指定したセルのデータがなぜか入らないという状況です。よろしくお願いします。
|
|
129
|
+
追記
|
|
130
|
+
どこまでデータが上書きされるのか確認するために
|
|
131
|
+
1-57(A-BE)に適当な値を入れてマクロを起動すると
|
|
132
|
+
1-45(A-AS)は空白に書き換わり
|
|
133
|
+
46-57(AT-BE)は値が入ったままになっています。
|
7
仕様の追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -120,4 +120,9 @@
|
|
|
120
120
|
途中までが空白セルに書き変わり、最後の数セルだけ指定した部分が空白になっていました。
|
|
121
121
|
昔別件でつかっていたマクロを改良して使いたかったのでポイントで直して、足して、消して、とやっていく間にどこを修正していいかわからなくなりました。
|
|
122
122
|
初心者で言葉足らずですが、ここはいらない、ここが足りない等お言葉を下さい。
|
|
123
|
-
よろしくお願いします。
|
|
123
|
+
よろしくお願いします。
|
|
124
|
+
追記
|
|
125
|
+
あまりにも言葉足らずでしたので追記します。
|
|
126
|
+
複数個のデータ（1シート目に取り込みたいデータがある）が入ったフォルダ（取り込まれる側）を選択し、取り込む側の2シート目に出力すというマクロです。
|
|
127
|
+
取り込む側のシート構成は１シート目に取り込んだデータのタイトルが並ぶ役割を、2シート目には指定したデータを集計する欄を作ってあります。
|
|
128
|
+
1シート目のタイトルは出てくるのですが、2シート目の集計シートに指定したセルのデータがなぜか入らないという状況です。よろしくお願いします。
|
6
。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -15,8 +15,6 @@
|
|
|
15
15
|
Dim sheetcount As Long
|
|
16
16
|
Dim unmatch As Long
|
|
17
17
|
Dim erfilecount As Long
|
|
18
|
-
```
|
|
19
|
-
```
|
|
20
18
|
'ボタンを押したとき
|
|
21
19
|
Sub FolderSelect()
|
|
22
20
|
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
@@ -48,8 +46,6 @@
|
|
|
48
46
|
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
49
47
|
ThisWorkbook.Worksheets(2).Activate
|
|
50
48
|
End Sub
|
|
51
|
-
```
|
|
52
|
-
```
|
|
53
49
|
'ファイル検索
|
|
54
50
|
Sub FileSearch(Path As String, Target As String)
|
|
55
51
|
Dim FSO As Object, Folder As Variant, File As Variant
|
|
@@ -68,8 +64,6 @@
|
|
|
68
64
|
ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
69
65
|
Next File
|
|
70
66
|
End Sub
|
|
71
|
-
```
|
|
72
|
-
```
|
|
73
67
|
''一覧出力
|
|
74
68
|
Sub ParCopy(Path As String)
|
|
75
69
|
Dim i As Long
|
|
@@ -79,8 +73,6 @@
|
|
|
79
73
|
Application.ScreenUpdating = False
|
|
80
74
|
On Error GoTo myError
|
|
81
75
|
Set openbook = Application.Workbooks.Open(Path)
|
|
82
|
-
```
|
|
83
|
-
```
|
|
84
76
|
'一覧化コピペ
|
|
85
77
|
For i = 1 To openbook.Worksheets.Count
|
|
86
78
|
Set openbooksheet = openbook.Worksheets(1)
|
5
VV
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -16,6 +16,7 @@
|
|
|
16
16
|
Dim unmatch As Long
|
|
17
17
|
Dim erfilecount As Long
|
|
18
18
|
```
|
|
19
|
+
```
|
|
19
20
|
'ボタンを押したとき
|
|
20
21
|
Sub FolderSelect()
|
|
21
22
|
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
@@ -48,6 +49,7 @@
|
|
|
48
49
|
ThisWorkbook.Worksheets(2).Activate
|
|
49
50
|
End Sub
|
|
50
51
|
```
|
|
52
|
+
```
|
|
51
53
|
'ファイル検索
|
|
52
54
|
Sub FileSearch(Path As String, Target As String)
|
|
53
55
|
Dim FSO As Object, Folder As Variant, File As Variant
|
|
@@ -67,6 +69,7 @@
|
|
|
67
69
|
Next File
|
|
68
70
|
End Sub
|
|
69
71
|
```
|
|
72
|
+
```
|
|
70
73
|
''一覧出力
|
|
71
74
|
Sub ParCopy(Path As String)
|
|
72
75
|
Dim i As Long
|
|
@@ -76,6 +79,7 @@
|
|
|
76
79
|
Application.ScreenUpdating = False
|
|
77
80
|
On Error GoTo myError
|
|
78
81
|
Set openbook = Application.Workbooks.Open(Path)
|
|
82
|
+
```
|
|
79
83
|
```
|
|
80
84
|
'一覧化コピペ
|
|
81
85
|
For i = 1 To openbook.Worksheets.Count
|
4
```
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -6,7 +6,7 @@
|
|
|
6
6
|
なぜか空白になってしまっています。
|
|
7
7
|
|
|
8
8
|
ソースがこちらです。
|
|
9
|
-
|
|
9
|
+
```
|
|
10
10
|
Option Explicit
|
|
11
11
|
|
|
12
12
|
Dim gyo As Long
|
|
@@ -15,7 +15,7 @@
|
|
|
15
15
|
Dim sheetcount As Long
|
|
16
16
|
Dim unmatch As Long
|
|
17
17
|
Dim erfilecount As Long
|
|
18
|
-
|
|
18
|
+
```
|
|
19
19
|
'ボタンを押したとき
|
|
20
20
|
Sub FolderSelect()
|
|
21
21
|
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
@@ -47,7 +47,7 @@
|
|
|
47
47
|
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
48
48
|
ThisWorkbook.Worksheets(2).Activate
|
|
49
49
|
End Sub
|
|
50
|
-
|
|
50
|
+
```
|
|
51
51
|
'ファイル検索
|
|
52
52
|
Sub FileSearch(Path As String, Target As String)
|
|
53
53
|
Dim FSO As Object, Folder As Variant, File As Variant
|
|
@@ -66,7 +66,7 @@
|
|
|
66
66
|
ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
67
67
|
Next File
|
|
68
68
|
End Sub
|
|
69
|
-
|
|
69
|
+
```
|
|
70
70
|
''一覧出力
|
|
71
71
|
Sub ParCopy(Path As String)
|
|
72
72
|
Dim i As Long
|
|
@@ -76,7 +76,7 @@
|
|
|
76
76
|
Application.ScreenUpdating = False
|
|
77
77
|
On Error GoTo myError
|
|
78
78
|
Set openbook = Application.Workbooks.Open(Path)
|
|
79
|
-
|
|
79
|
+
```
|
|
80
80
|
'一覧化コピペ
|
|
81
81
|
For i = 1 To openbook.Worksheets.Count
|
|
82
82
|
Set openbooksheet = openbook.Worksheets(1)
|
|
@@ -116,7 +116,7 @@
|
|
|
116
116
|
erfilecount = erfilecount + 1
|
|
117
117
|
Application.ScreenUpdating = True
|
|
118
118
|
End Sub
|
|
119
|
-
|
|
119
|
+
```
|
|
120
120
|
|
|
121
121
|
|
|
122
122
|
どこまで動いているか確認するために
|
3
'
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -15,7 +15,7 @@
|
|
|
15
15
|
Dim sheetcount As Long
|
|
16
16
|
Dim unmatch As Long
|
|
17
17
|
Dim erfilecount As Long
|
|
18
|
-
|
|
18
|
+
'''
|
|
19
19
|
'ボタンを押したとき
|
|
20
20
|
Sub FolderSelect()
|
|
21
21
|
ThisWorkbook.Worksheets(1).Range("A6:C3005").ClearContents
|
|
@@ -47,6 +47,7 @@
|
|
|
47
47
|
ThisWorkbook.Worksheets(1).Range("B2").Value = "完了"
|
|
48
48
|
ThisWorkbook.Worksheets(2).Activate
|
|
49
49
|
End Sub
|
|
50
|
+
'''
|
|
50
51
|
'ファイル検索
|
|
51
52
|
Sub FileSearch(Path As String, Target As String)
|
|
52
53
|
Dim FSO As Object, Folder As Variant, File As Variant
|
|
@@ -65,6 +66,7 @@
|
|
|
65
66
|
ThisWorkbook.Worksheets(1).Range("B3").Value = filecount & "個のファイルが見つかりました。"
|
|
66
67
|
Next File
|
|
67
68
|
End Sub
|
|
69
|
+
'''
|
|
68
70
|
''一覧出力
|
|
69
71
|
Sub ParCopy(Path As String)
|
|
70
72
|
Dim i As Long
|
|
@@ -74,7 +76,7 @@
|
|
|
74
76
|
Application.ScreenUpdating = False
|
|
75
77
|
On Error GoTo myError
|
|
76
78
|
Set openbook = Application.Workbooks.Open(Path)
|
|
77
|
-
|
|
79
|
+
'''
|
|
78
80
|
'一覧化コピペ
|
|
79
81
|
For i = 1 To openbook.Worksheets.Count
|
|
80
82
|
Set openbooksheet = openbook.Worksheets(1)
|
2
シングルコーテーションでソースを囲みました。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -6,6 +6,7 @@
|
|
|
6
6
|
なぜか空白になってしまっています。
|
|
7
7
|
|
|
8
8
|
ソースがこちらです。
|
|
9
|
+
'''
|
|
9
10
|
Option Explicit
|
|
10
11
|
|
|
11
12
|
Dim gyo As Long
|
|
@@ -113,9 +114,9 @@
|
|
|
113
114
|
erfilecount = erfilecount + 1
|
|
114
115
|
Application.ScreenUpdating = True
|
|
115
116
|
End Sub
|
|
117
|
+
'''
|
|
116
118
|
|
|
117
119
|
|
|
118
|
-
|
|
119
120
|
どこまで動いているか確認するために
|
|
120
121
|
取り込む側の3行目に適当な値を入れて実行してみたところ、
|
|
121
122
|
途中までが空白セルに書き変わり、最後の数セルだけ指定した部分が空白になっていました。
|
1
テンプレートのシングルコーテーションが紛らわしいので消しました。
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,10 +1,10 @@
|
|
|
1
1
|
エクセルでマクロを組んでいます
|
|
2
2
|
別ファイルの指定した個所の値を取り込みたいです。
|
|
3
3
|
|
|
4
|
-
|
|
4
|
+
|
|
5
5
|
途中までは動いているのですが指定した個所の値ではなく、
|
|
6
6
|
なぜか空白になってしまっています。
|
|
7
|
-
|
|
7
|
+
|
|
8
8
|
ソースがこちらです。
|
|
9
9
|
Option Explicit
|
|
10
10
|
|
|
@@ -115,7 +115,6 @@
|
|
|
115
115
|
End Sub
|
|
116
116
|
|
|
117
117
|
|
|
118
|
-
```
|
|
119
118
|
|
|
120
119
|
どこまで動いているか確認するために
|
|
121
120
|
取り込む側の3行目に適当な値を入れて実行してみたところ、
|