質問編集履歴

3

コード全体の追加

2020/09/19 04:12

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -10,6 +10,8 @@
10
10
 
11
11
 
12
12
 
13
+ コード全体の大まかな仕様と、ソースは最下部に参考として、載せておきます。(参考までに)
14
+
13
15
 
14
16
 
15
17
  code1
@@ -67,3 +69,183 @@
67
69
  i = i + 1
68
70
 
69
71
  ```
72
+
73
+
74
+
75
+ コード全体
76
+
77
+ ```Macro
78
+
79
+ Sub sample1()
80
+
81
+
82
+
83
+ Dim lngRowsNo As Long ' 書きこむ位置
84
+
85
+ Dim lngSheetIndex As Long ' シートの番号
86
+
87
+ Dim strFile As String ' Excelファイルの場所
88
+
89
+ Dim xlsAcq As New Excel.Application ' 取得側Excel
90
+
91
+ Dim wbAcq As Workbook ' 取得側Excelブック
92
+
93
+ Dim wsAcq As Worksheet ' 取得側Excelシート
94
+
95
+ Dim wsSet As Worksheet ' 設定側Excelシート
96
+
97
+ Const strPath As String = "パスの指定"
98
+
99
+ Set wsSet = ActiveSheet
100
+
101
+ Dim i As Long
102
+
103
+
104
+
105
+
106
+
107
+ strFile = Dir(strPath & "*.xls")
108
+
109
+ lngRowsNo = 2
110
+
111
+ Do Until strFile = ""
112
+
113
+ '----- Excelブックを開く
114
+
115
+ Set wbAcq = Workbooks.Open(strPath & strFile)
116
+
117
+
118
+
119
+ '----- シートを検索
120
+
121
+ For lngSheetIndex = 1 To wbAcq.Worksheets.Count
122
+
123
+ '----- 「更新」シートを検索
124
+
125
+ If wbAcq.Worksheets(lngSheetIndex).Name = "更新" Then
126
+
127
+ '----- 「更新」シートを変数へ登録
128
+
129
+ Set wsAcq = wbAcq.Worksheets(lngSheetIndex)
130
+
131
+ '----- 「更新」シートの内容を現在のシートにコピー(自由に変更して下さい)
132
+
133
+ With wsAcq
134
+
135
+ Dim n As Long 'ループで使用します。
136
+
137
+ Dim m As Long 'ループで使用します。
138
+
139
+ Dim ec1 As Long '各開発の一番下の担当者のセルを取得
140
+
141
+
142
+
143
+ For i = 1 To .UsedRange.Rows.Count
144
+
145
+
146
+
147
+ If Left(.Cells(i, 2).Value, 2) = "開発" Then
148
+
149
+
150
+
151
+ ' ------ 開発〇から一番上の担当者のセル位置を相対的にCells(i + 3, 3)として取得し
152
+
153
+ 'データの入っているところまでループさせる (その時、開発名を転記)
154
+
155
+
156
+
157
+ ec1 = .Cells(i + 3, 3).End(xlDown).Row
158
+
159
+ For n = i + 3 To ec1
160
+
161
+
162
+
163
+ wsSet.Cells(lngRowsNo, 2).Value = .Cells(i, 2).Value
164
+
165
+
166
+
167
+ For m = i + 3 To ec1
168
+
169
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value
170
+
171
+ Next m
172
+
173
+
174
+
175
+
176
+
177
+ lngRowsNo = lngRowsNo + 1
178
+
179
+
180
+
181
+ Next n
182
+
183
+
184
+
185
+ End If
186
+
187
+ Next i
188
+
189
+ End With
190
+
191
+ '----- 書きこむ位置移動
192
+
193
+
194
+
195
+ '----- 検索の終了
196
+
197
+ Exit For
198
+
199
+ End If
200
+
201
+ Next lngSheetIndex
202
+
203
+
204
+
205
+ '----- シート参照の解放
206
+
207
+ Set wsAcq = Nothing
208
+
209
+ '----- ブックを閉じる
210
+
211
+ wbAcq.Close Savechanges:=False
212
+
213
+ '----- 次のファイルへ
214
+
215
+ strFile = Dir()
216
+
217
+ Loop
218
+
219
+
220
+
221
+ '----- Excelへの参照の解放
222
+
223
+ Set xlsAcq = Nothing
224
+
225
+
226
+
227
+ End Sub
228
+
229
+ ```
230
+
231
+
232
+
233
+
234
+
235
+ ■マクロの概要
236
+
237
+ 以下の画像のようにブックからブックへ転記をしたいです。
238
+
239
+ その時、転記元のエクセルファイル(拡張子はxls)が格納されているフォルダを指定してそのフォルダ内のエクセルファイルすべてに対してに「更新」というシートがあるときだけ以下の画像のように転記を実行したいです。(現在は作成途中で担当者を転記先のように転記したいです。)
240
+
241
+
242
+
243
+ 転記元
244
+
245
+ ![転記元](d8e88eaf75129b0813b2d93a294a162d.png)
246
+
247
+
248
+
249
+ 転記先
250
+
251
+ ![転記先](e51ba7b98d24dd2c5f9ea2831d9e1e19.png)

2

内容の修正

2020/09/19 04:12

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -1,22 +1,10 @@
1
1
  以下のコードcode1で①のnの値に干渉せずに②のi+3をループさせたいです。
2
-
3
-
4
-
5
-
6
-
7
- ```Macro
8
-
9
- wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
10
-
11
- i = i + 1
12
-
13
- ```
14
2
 
15
3
 
16
4
 
17
- 一度上記のように記載したのですが、もちろんそれだと①のnも同時に+1されてしまいます。
5
+ 一度code2のように記載したのですが、もちろんそれだと①のnも同時に+1されてしまいます。
18
6
 
19
- 別の変数を用意して、ループさせる方法を試そうとしたのですが(その際に m を使いました)書き方がわからずうまく実装できませんでしたので、その書き方を教えていただきたいです。
7
+ 別の変数を用意して、mとnを別でループさせたのですが書き方がわからずうまく実装できませんでしたので、その書き方を教えていただきたいです。
20
8
 
21
9
  よろしくお願いします。
22
10
 
@@ -48,7 +36,11 @@
48
36
 
49
37
 
50
38
 
39
+ For m = i + 3 To ec1
40
+
51
- wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
41
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
42
+
43
+ Next m
52
44
 
53
45
 
54
46
 
@@ -63,3 +55,15 @@
63
55
 
64
56
 
65
57
  ```
58
+
59
+
60
+
61
+ code2
62
+
63
+ ```Macro
64
+
65
+ wsSet.Cells(lngRowsNo, 3).Value = .Cells(i + 3, 3).Value '②
66
+
67
+ i = i + 1
68
+
69
+ ```

1

内容の修正

2020/09/19 04:03

投稿

icecleam
icecleam

スコア46

test CHANGED
File without changes
test CHANGED
@@ -1,4 +1,4 @@
1
- 以下のコードで①のnの値に干渉せずに②のi+3をループさせたいです。
1
+ 以下のコードcode1で①のnの値に干渉せずに②のi+3をループさせたいです。
2
2
 
3
3
 
4
4
 
@@ -24,7 +24,7 @@
24
24
 
25
25
 
26
26
 
27
-
27
+ code1
28
28
 
29
29
  ```Macro
30
30